home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
rbbsbas.zip
/
RBBS-PC.BAS
< prev
next >
Wrap
BASIC Source File
|
1988-10-03
|
139KB
|
4,290 lines
3 ' $linesize: 132
4 ' $title: 'RBBS CPC17-1A, Copyright 1988 by D. Thomas Mack'
5 ' WARNING !!! DO NOT CHANGE, BYPASS OR REMOVE LINES 3-29
9 'by D. Thomas Mack, 39 Cranbury Drive, Trumbull, CT 06611
10 ' Jon J. Martin, 4396 N. Prairie Willow Ct., Concord, CA 94521
11 ' Ken Goosens, 5020 Portsmouth Road, Fairfax, VA 22032
13 '
14 ' *******************************NOTICE*************************************
15 ' * A limited license is granted to all users of this program and it's *
16 ' * companion program, CONFIG (version 17-1A), to make copies of this *
17 ' * program and distribute the copies to other users, on the following *
18 ' * conditions: *
19 ' * 1. The notices contained in lines 3 through 29 of the program *
20 ' * are not altered, bypassed, or removed. *
21 ' * 2. The program is not to be distributed to others in modified *
22 ' * form (i.e. the line numbers must remain the same). *
23 ' * 3. No fee is to be charged (or any other consideration received) *
24 ' * for copying or distributing these programs without an express *
25 ' * written agreement with D. Thomas Mack, The Second Ring, 39 *
26 ' * Cranbury Drive, Trumbull, Conneticut 06611 *
27 ' * *
28 ' * Copyright (c) 1983-1988 D. Thomas Mack, The Second Ring *
29 ' **************************************************************************
'
' $INCLUDE: 'RBBS-VAR.BAS'
'
' $SUBTITLE: 'Main-line RBBS-PC Program'
CRLF$ = CHR$(13) + CHR$(10)
J = 60
REDIM OPT.SEC(J)
CONFIG.FILENAME$ = "RBBS-PC.DEF"
CALL GETCOMND (DEBUG,NETIME$,NETBAUD$,NETRELIABLE$)
SUBROUTINE.PARAMETER = -62
BULLETIN.MENU$ = ""
CALL READDEF (CONFIG.FILENAME$)
IF EC > 0 THEN _
GOTO 31
CALL GIVEINIT
CALL MLINIT (1)
IF RECYCLE.TO.DOS OR DEBUG THEN _
GOTO 100
SUBROUTINE.PARAMETER = -9
CALL CARRIER
IF SUBROUTINE.PARAMETER THEN _
CALL COPYWRIT
GOTO 100
31 SNOOP = -1
CALL PSCRN ("Configuration "+CONFIG.FILENAME$+" missing or improper format.") : _
GOTO 204
100 CLEAR,,SIZE.OF.STACK
DEF SEG ' Point to BASIC
WIDTH 80 ' Set Screen Width
SCREEN 0,0,0 ' Text, No color, Pg 0
KEY OFF ' Line 25 turned off
DEFINT A-Z ' All var. integer
' ********************* Variable Definitions ********************************
102 ADIM = 99
MM = 999
BX = 75
J = 60
REDIM OPT.SEC(J)
REDIM CATEGORY.NAME$(BX),CATEGORY.CODE$(BX),CATEGORY.DESC$(BX)
REDIM A$(ADIM) ' Message line table
REDIM B$(ADIM) ' Message line table
REDIM M(MM,2) ' Message pointers
CALL VARINIT
105 VERSION.ID$ = "CPC17-1A"
106 CALL GETCOMND (DEBUG,NETIME$,NETBAUD$,NETRELIABLE$)
SUBROUTINE.PARAMETER = 1
CALL READDEF (CONFIG.FILENAME$)
IF EC > 0 THEN _
GOTO 31
USE.TPUT = (UPPER.CASE OR XON.XOFF)
ORIG.CALLERS$ = CALLERS.FILE$
ORIG.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$
ORIG.USER.FILE$ = MAIN.USER.FILE$
CALL BRKFNAME (ORIG.MESSAGE.FILE$,DRV$,ORIG.MSG.NAME$,Y$,FALSE)
IF ORIG.MSG.NAME$ = "MESSAGES" THEN _
ORIG.MSG.NAME$ = "MAIN" _
ELSE IF RIGHT$(ORIG.MSG.NAME$,1) = "M" THEN _
ORIG.MSG.NAME$ = LEFT$(ORIG.MSG.NAME$,LEN(ORIG.MSG.NAME$)-1)
GRN.NAME$ = ORIG.MSG.NAME$
MAX.MESSAGE.LINES = MAX.MESSAGE.LINES.DEF
IF NET.MAIL$ <> "NONE" AND VAL(NETIME$) > 0 THEN _
LIMIT.MINUTES.PER.SESSION! = VAL(NETIME$)
IF NET.MAIL$ <> "NONE" AND VAL(NETBAUD$) > 0 THEN _
EXPECT.ACTIVE.MODEM = TRUE : _
IF NOT KEEP.INIT.BAUD THEN _
MODEM.INIT.BAUD$ = NETBAUD$
IF FOSSIL THEN _
COMPORT% = VAL(RIGHT$(COM.PORT$,1)) - 1 : _
IF COMPORT% < 0 THEN _
GOTO 108 _
ELSE CALL FOSINIT(COMPORT%,RESULT%) : _
IF RESULT% = -1 THEN _
SNOOP = TRUE : _
CALL PSCRN("ERROR INITIALIZING FOSSIL") : _
GOTO 204
108 CALL BRKFNAME (CALLERS.FILE$,DRV$,X$,Y$,TRUE)
ARC.WORK$ = DRV$ + _
"ARCWORK" + _
NODE.FILE.ID$ + _
".DEF"
IF USE.BASIC.WRITES THEN _
LOCAL.BACKSPACE$ = BACK.ARROW$ _
ELSE LOCAL.BACKSPACE$ = BACKSPACE$
SYSOP.FULL.NAME$ = LEFT$(SYSOP.FIRST.NAME$ + " " + SYSOP.LAST.NAME$,22)
'
' ***** INITIALIZE NETBIOS INTERFACE *****
'
IF NETWORK.TYPE = 6 AND NOT SUB.BOARD THEN _
CALL INITIBM
'
' ***** ESTABLISH NEXT CALLERS FILE RECORD AVAILABLE ****
'
CALL SETCALL
112 IF NOT SUB.BOARD THEN _
LOCAL.USER = TRUE : _
A$ = COLOR.RESET$ : _
SUBROUTINE.PARAMETER = 1 : _
CALL TPUT : _
LOCAL.USER = FALSE
UPLOAD.DRIVE.FILE$ = RIGHT$(DOWNLOAD.DRIVES$,1)+":FREESPAC.UPL"
'
' ***** TEST FOR MESSAGE FILE PRESENT (ABORT IF NOT PRESENT) *****
'
135 IF CURRENT.DEF$ = ORIG.CONFIG$ THEN _
ACTIVE.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$ : _
ACTIVE.USER.FILE$ = MAIN.USER.FILE$
GOSUB 4910
IF CONFERENCE.MODE THEN _
GOTO 150
LOCAL.USER.MODE = (RIGHT$(COM.PORT$,1) < "1")
GET 1,NODE.RECORD.INDEX
Y$ = MID$(MESSAGE.RECORD$,77,2)
CALL UNCDATE (Y$,X,L,I,OLD.DAT$)
OLD.DAT$ = LEFT$(OLD.DAT$,6) + MID$(STR$(X),2)
TIME.TO.DROP.TO.DOS = - (TIME.TO.DROP.TO.DOS > 0) * TIME.TO.DROP.TO.DOS
HR! = INT(TIME.TO.DROP.TO.DOS / 100)
MN! = TIME.TO.DROP.TO.DOS - HR! * 100
TIME.TO.DROP.TO.DOS! = HR! * 3600 + MN! * 60
'
' ****** TEST FOR TIMED EXIT ACTIVE ***** *
'
140 CALL FINDTIME (TI!)
IF TIME.TO.DROP.TO.DOS > 0 AND _
OLD.DAT$ <> DATE$ AND _
TI! >= TIME.TO.DROP.TO.DOS! THEN _
GOTO 206
'
' **** GET CURRENT STATUS OF SYSOP AVAIL, SYSOP ANNOY, SYSOP NEXT, & PRINTER *
'
150 IF SUB.BOARD THEN _
GOSUB 12987 : _
GOSUB 5135 : _
GOTO 170
SYSOP.AVAILABLE = VAL(MID$(MESSAGE.RECORD$,32,2))
SYSOP.ANNOY = VAL(MID$(MESSAGE.RECORD$,34,2))
SYSOP.NEXT = VAL(MID$(MESSAGE.RECORD$,36,2))
MID$(MESSAGE.RECORD$,36,2) = STR$(FALSE)
PRINTER = VAL(MID$(MESSAGE.RECORD$,38,2))
IF TURN.PRINTER.OFF THEN _
PRINTER = FALSE
EXIT.TO.DOORS = (VAL(MID$(MESSAGE.RECORD$,40,2)) AND NETBAUD$ = "")
EIGHT.BIT = VAL(MID$(MESSAGE.RECORD$,42,2))
BPS = VAL(MID$(MESSAGE.RECORD$,44,2))
SNOOP = VAL(MID$(MESSAGE.RECORD$,58,2))
MID$(MESSAGE.RECORD$,57,1) = "I"
PRIVATE.DOOR = VAL(MID$(MESSAGE.RECORD$,72,2))
MID$(MESSAGE.RECORD$,72,2) = STR$(FALSE)
LOCAL.USER = VAL(MID$(MESSAGE.RECORD$,101,2))
IF EXIT.TO.DOORS OR PRIVATE.DOOR THEN _
TURBO.LOGON = TRUE
PUT 1,NODE.RECORD.INDEX
GOSUB 12985
'
' ***** TEST FOR MULTI LINK PRESENT IF NOT COMPAQ COMPUTER *****
'
160 CALL MLINIT (4)
170 FOR FUNCTION.KEY.INDEX = 1 TO 10
KEY FUNCTION.KEY.INDEX,""
NEXT
CALL LOADNEW (M())
'
' ****** INITIALIZE FILE MANAGEMENT SYSTEM, CHECK FOR LOCAL BBS MODE *
'
175 GOSUB 5344
CALL CTLINES (MAX.ENTRIES)
REDIM CATEGORY.NAME$(MAX.ENTRIES),CATEGORY.CODE$(MAX.ENTRIES),_
CATEGORY.DESC$(MAX.ENTRIES) : _
CALL INITFMS (CATEGORY.NAME$(),CATEGORY.CODE$(), _
CATEGORY.DESC$(),NUM.CATEGORIES)
LOCAL.USER.MODE = (RIGHT$(COM.PORT$,1) < "1")
IF NOT LOCAL.USER THEN _
LOCAL.USER = LOCAL.USER.MODE
REMOTE.ECHO = (DEFAULT.ECHOER$ = "R" AND NOT LOCAL.USER.MODE)
CALL BRKFNAME (CALLERS.FILE$,DRV$,X$,Y$,TRUE)
NODE.WORK.FILE$ = DRV$ + _
"NODE" + _
NODE.FILE.ID$ + _
"WRK"
SECONDS.PER.SESSION! = MINUTES.PER.SESSION! * 60
IF NOT LOCAL.USER.MODE THEN _
IF NOT EXIT.TO.DOORS THEN _
GOTO 180 _
ELSE IF NOT LOCAL.USER THEN _
GOTO 180
LOCAL.USER = TRUE
BPS = -6
BAUD.TEST = 9600
EIGHT.BIT = TRUE
SNOOP = TRUE
RECYCLE.TO.DOS = TRUE
IF EXIT.TO.DOORS THEN _
CALL AMORPM : _
CALL READPROF : _
GOTO 410
GOSUB 178
GOTO 345
178 IF SUB.BOARD THEN _
IF FIRST.NAME$ = SYSOP.FIRST.NAME$ AND _
LAST.NAME$ = SYSOP.LAST.NAME$ THEN _
RETURN 832 _
ELSE RETURN 800
RETURN
180 SUBROUTINE.PARAMETER = 2
CALL LINE25
GOSUB 178
'
' ****** WAIT FOR THE PHONE TO RING AND ANSWER IT *****
'
SUBROUTINE.PARAMETER = 1
200 TOGGLE.ONLY = TRUE
CALL ANSWERIT
GET 1,NODE.RECORD.INDEX
SNOOP = VAL(MID$(MESSAGE.RECORD$,58,2))
TOGGLE.ONLY = FALSE
IF EC > 1 THEN _
GOTO 13000
IF SUBROUTINE.PARAMETER < 0 THEN _
GOTO 202
ON SUBROUTINE.PARAMETER GOTO 410, _ ' 1 = ANSWERED PHONE & CARRIER FOUND
330, _ ' 2 = CARRIER FOUND BEFORE ANSWERING
822, _ ' 3 = SYSOP GETS SYSTEM NEXT
10595, _ ' 4 = ANSWERED PHONE BUT NO CARRIER
13540, _ ' 5 = NOT USED
202, _ ' 6 = LOCAL SYSOP KEY PRESSED
206, _ ' 7 = TIME TO DROP TO DOS
13538 ' 8 = NO CALLS! TIME TO RECYCLE
202 FF = -SUBROUTINE.PARAMETER
ON FF GOTO 10595, _ ' -1 = CARRIER DROPPED
4770, _ ' -2 = SYSOP INITIATED CHAT
205, _ ' -3 = FORCE SYSTEM TO ANSWER THE PHONE
204, _ ' -4 = EXIT TO DOS IMMEDEATELY
203, _ ' -5 = EXIT TO DOS AFTER CLEAN-UP
10698, _ ' -6 = INDICATE ACCESS IS DENIED AND LOGOFF USER
10620 ' -7 = UPDATE CALLERS FILE AND LOGOFF USER
203 CALL MLINIT(3)
204 IF FOSSIL THEN _
CALL FOSEXIT(COMPORT%)
SYSTEM
205 SUBROUTINE.PARAMETER = 4
GOTO 200
206 CALL TIMEDOUT
GOTO 203
330 CALL CARRIER
IF SUBROUTINE.PARAMETER = -1 THEN _
GOTO 10595
CALL EOFCOMM (CHAR%)
IF CHAR% = -1 THEN _
GOTO 335
CALL FLUSHCOM (DF$)
IF SUBROUTINE.PARAMETER = -1 THEN _
GOTO 10595
GOTO 330
335 EXIT.TO.DOORS = FALSE
PRIVATE.DOOR = FALSE
IF C.L <> 1 THEN _
LOCATE 22,34
D$ ="CONNECT" + _
STR$(BAUD.TEST) + _
" "
GOSUB 1315
'
' ***** DISPLAY WELCOME LINE *****
'
345 LOCATE 24,1
SUBROUTINE.PARAMETER = 1
CALL AMORPM
CALL FINDTIME (USER.LOGON.TIME!)
TIME.LOGGED.ON$ = TIME$
LINES.PRINTED = 0
EXPERT.USER.DEF = EXPERT.USER
EXPERT.USER = FALSE
CALL SETEXPERT
IF NODES.IN.SYSTEM > 1 THEN _
A$ = " - NODE " + NODE.ID$ _
ELSE A$ = ""
CALL QTPUT("WELCOME TO " + RBBS.NAME$ + A$,1)
TEST.PARITY = TRUE
STOP.INTERRUPTS = TRUE
FILE.NAME$ = PRELOG$
CALL FLUSHCOM (X$)
COMMPORT.STACK$ = ""
346 GOSUB 466
FF = FALSE
'
' ***** GET USER NAME *
' ***** C - COMMAND FROM NEWUSER REGISTER OPTIONS (CHANGE NAME OR ADDRESS) *
'
400 CALL SKIPLINE(1)
ESCAPE.INSECURE = FALSE
UPPER.CASE = FALSE
EXPERT.USER = EXPERT.USER.DEF
CALL SETEXPERT
A1$ = "What is your "
GOSUB 12500
CALL COMMINFO
IF FF THEN _
LOGON.ERROR.INDEX = 1 : _
GOTO 10620
IF MIN.OLDCALLER.BAUD > BAUD.TEST THEN _
CALL QTPUT (MID$(STR$(BAUD.TEST),2) + " BAUD ACCESS NOT ALLOWED!",2) : _
LG$(7) = "OLD CALLER BAUD RESTRICTION" : _
LOGON.ERROR.INDEX = 7 : _
GOTO 10620
TURBO.LOGON = (LEFT$(B$(4),1) = "!")
HOME.CONFERENCE$ = RIGHT$(B$(4),LEN(B$(4)) + TURBO.LOGON)
'
' ***** CHECK IF SAME USER ON ANOTHER NODE ****
'
410 IF EXIT.TO.DOORS THEN _
CURRENT.DATE$ = MID$(MESSAGE.RECORD$,119,2) + _
"-" + _
MID$(MESSAGE.RECORD$,121,2) + _
"-" + _
MID$(MESSAGE.RECORD$,123,2) : _
TIM$ = MID$(MESSAGE.RECORD$,125,2) + _
":" + _
RIGHT$(MESSAGE.RECORD$,2) : _
IF LEFT$(TIM$,2) < "12" THEN _
TIM$ = TIM$ + _
" AM" _
ELSE TIM$ = TIM$ + _
" PM"
NODE.INDEX = 2
XX = NODES.IN.SYSTEM + 1
412 IF NODE.INDEX > XX THEN _
GOTO 430
GET 1,NODE.INDEX
IF INSTR(MESSAGE.RECORD$,ACTIVE.USER.NAME$) THEN _
GOTO 420
NODE.INDEX = NODE.INDEX + 1
GOTO 412
420 IF MID$(MESSAGE.RECORD$,57,1) = "A" THEN _
LOGON.ERROR.INDEX = 6 : _
LG$(6) = LG$(6) + _
LEFT$(MESSAGE.RECORD$,25) : _
A$ = "Name <" + ACTIVE.USER.NAME$ + "> in use on another node" : _
CALL RINGCALLER : _
GOTO 10620
FIRST.NAME$ = LEFT$(MESSAGE.RECORD$,INSTR(MESSAGE.RECORD$, " ") - 1)
IF NOT PRIVATE.DOOR THEN _
CALL SKIPLINE (1) : _
CALL QTPUT(FIRST.NAME$ + ", welcome back!",1)
'
' ***** TEST FOR REMOTE SYSOP LOGGING ON ****
'
430 GET 1,NODE.RECORD.INDEX
SAME.USER = (ACTIVE.USER.NAME$ = LEFT$(MESSAGE.RECORD$,LEN(ACTIVE.USER.NAME$)))
'
' ***** TEST FOR SYSOP NAME ATTEMPT ****
'
445 IF INSTR(ACTIVE.USER.NAME$,"SYSOP") OR _
INSTR(ACTIVE.USER.NAME$,SYSOP.FIRST.NAME$ + " " + SYSOP.LAST.NAME$) THEN _
LOGON.ERROR.INDEX = 2 : _
GOTO 10620
'
' ***** REMOVE INVALID CHARACTERS FROM USER NAME ****
'
455 CALL BADCHAR (ACTIVE.USER.NAME$)
IF ACTIVE.USER.NAME$ = "" THEN _
GOTO 400
'
' **** CHECK FOR ACTIVE USER ****
'
457 CALL SKIPLINE (1)
GOSUB 12840
GOSUB 12850
GOSUB 12598
GOSUB 11482
CALL COMPDATE (TODAY.REG.YY,TODAY.REG.MM,TODAY.REG.DD,TODAY.COMPUTE.DATE!)
IF NOT FOUND THEN _
GOTO 700
GOSUB 12984
'
' ***** ACTIVE USER FOUND *****
'
459 GOSUB 9500
LAST.DATE.TIME.ON.SAVE$ = LAST.DATE.TIME.ON$
IF EXIT.TO.DOORS THEN _
TEMP.HOLD.TIME! = VAL(LEFT$(TIM$,2))*3600 + _
VAL(MID$(TIM$,4,2))*60 : _
CALL FINDTIME (USER.LOGON.TIME!) : _
MINUTES.IN.DOORS = INT((USER.LOGON.TIME! - _
(USER.LOGON.TIME! <= TEMP.HOLD.TIME!)*86400 - _
TEMP.HOLD.TIME!) / 60) : _
CALL TIMEREMAIN (TIME.REMAINING!)
USER.FILE.INDEX = LOC(5)
GOSUB 5135
'
' *** COMPUTE THE NUMBER OF DAYS REMAINING UNTIL REGISTRATION EXPIRES ***
'
IF RESTRICT.BY.DATE THEN _
CALL COMPDATE (USER.REG.YY,USER.REG.MM,USER.REG.DD,USER.COMPUTE.DATE!) : _
REG.DAYS.REMAINING = USER.COMPUTE.DATE! + _
DAYS.IN.REGISTRATION.PERIOD - _
TODAY.COMPUTE.DATE! : _
CALL EXPDATE (USER.COMPUTE.DATE!,DAYS.IN.REGISTRATION.PERIOD,EXPIRATION.DATE$) _
ELSE REG.DAYS.REMAINING = 365
IF NOT PRIVATE.DOOR THEN _
IF REG.DAYS.REMAINING < 0 THEN _
IF USER.SECURITY.LEVEL > EXPIRED.SECURITY THEN _
CALL QTPUT (LG$(9) + _
" - security reset to " + _
STR$(EXPIRED.SECURITY),1) : _
LOGON.ERROR.INDEX = 9 : _
USER.SECURITY.LEVEL = EXPIRED.SECURITY : _
LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL) : _
GOSUB 5135
460 USER.SECURITY.LEVEL$ = STR$(USER.SECURITY.LEVEL)
IF USER.SECURITY.LEVEL > -1 THEN _
USER.SECURITY.LEVEL$ = MID$(USER.SECURITY.LEVEL$,2)
IF USER.SECURITY.LEVEL >= MINIMUM.LOGON.SECURITY THEN _
GOTO 470
IF NOT PRIVATE.DOOR THEN _
GOSUB 465 : _
CALL DELAYIT (8 + BPS)
IF LOGON.ERROR.INDEX < 9 AND _
EC = 0 THEN _
LOGON.ERROR.INDEX = 8
GOTO 10620
'
' *** DISPLAY LOG-ON MESSAGE FOR SPECIFIC SECURITY LEVEL ***
'
465 TURBO.LOGON = TURBO.LOGON AND (EXIT.TO.DOORS OR _
(USER.SECURITY.LEVEL >= ALLOW.CALLER.TURBO))
IF TURBO.LOGON THEN _
RETURN
FILE.NAME$ = WELCOME.FILE.DRV.PATH$ + _
"LG" + _
USER.SECURITY.LEVEL$ + _
".DEF"
466 STOP.INTERRUPTS = TRUE
BYPASS.TIME.CHECK = TRUE
CALL BUFFILE (FILE.NAME$,X)
RETURN
470 GOSUB 12989
CI$ = CITY.STATE$
CALL TRIM (CI$)
ATTEMPTS.ALLOWED = 4
PASSWORD.SAVE$ = PASSWORD$
TEMP.SYSOP = (USER.SECURITY.LEVEL >= SYSOP.SECURITY.LEVEL)
MESSAGE.PASSWORD = FALSE
IF NOT SUB.BOARD THEN _
ELAPSED.TIME = CVI(ELAPSED.TIME$)
IF NOT EXIT.TO.DOORS THEN _
IF CURRENT.DATE$ <> LEFT$(LAST.DATE.TIME.ON$,8) THEN _
IF ELAPSED.TIME > 0 OR NOT KEEP.TIME.CREDITS THEN _
ELAPSED.TIME = 0
IF PRIVATE.DOOR AND _
TRANSFER.FUNCTION = 3 THEN _
GOSUB 755 : _
GOTO 800
IF PASSWORD.SAVE$ = SPACE$(LEN(PASSWORD.SAVE$)) THEN _
GOSUB 755 : _
GOTO 800
480 GOSUB 5370
IF PRIVATE.DOOR OR (A AND ESCAPE.INSECURE) THEN _
Z$ = PASSWORD.SAVE$ : _
PASSWORD.FAILED = 0 : _
GOTO 644
IF Q => 3 THEN _
Z$ = B$(3) : _
ATTEMPTS = 1 : _
SUBROUTINE.PARAMETER = 5 _
ELSE SUBROUTINE.PARAMETER = 4
CALL PASSWRD
630 IF PASSWORD.FAILED THEN _
LOGON.ERROR.INDEX = 4 : _
GOTO 10620
643 GOSUB 41070
644 NEW.USER = FALSE
WK$ = RIGHT$(STR$(ASC(MID$(LIST.NEW.DATE$,2))),2) + _ ' MM
"/" + _
RIGHT$(STR$(ASC(MID$(LIST.NEW.DATE$,3))),2) + _ ' DD
"/" + _
RIGHT$(STR$(ASC(LIST.NEW.DATE$)),2) ' YY
LM$ = RIGHT$(WK$,2) + _ ' YY
LEFT$(WK$,2) + _ ' MM
MID$(WK$,4,2) ' DD
IF MID$(LM$,3,1) = " " THEN _
MID$(LM$,3,1) = "0"
655 IF MID$(LM$,5,1) = " " THEN _
MID$(LM$,5,1) = "0"
660 CALL MUZAK (1)
GOTO 800
'
' **** ACTIVE USER NOT FOUND (NEWUSER ROUTINE) ****
'
700 EXPERT.USER = FALSE
CALL SETEXPERT
IF MIN.NEWCALLER.BAUD > BAUD.TEST THEN _
CALL QTPUT ("(" + MID$(STR$(BAUD.TEST),2) + " BAUD ACCESS FOR REGISTERED USERS ONLY)",2) : _
LG$(7) = "NEW CALLER BAUD RESTRICTION" : _
LOGON.ERROR.INDEX = 7 : _
GOTO 10620
CALL QTPUT ("Name not found",1)
GOSUB 12558
IF NO THEN _
GOSUB 12990 : _
GOTO 400
Z$ = FIRST.NAME$
GOSUB 12570
IF FOUND THEN _
GOSUB 12984 : _
GOTO 12595
Z$ = LAST.NAME$
GOSUB 12570
IF FOUND THEN _
GOSUB 12984 : _
GOTO 12595
TURBO.LOGON = FALSE
710 IF USER.FILE.INDEX = 0 AND NOT SURVIVE.NOUSER.ROOM THEN _
GOTO 13540
720 GOSUB 5370
IF A THEN _
USER.SECURITY.LEVEL = SYSOP.SECURITY.LEVEL _
ELSE USER.SECURITY.LEVEL = DEFAULT.SECURITY.LEVEL
725 IF USER.SECURITY.LEVEL < MINIMUM.LOGON.SECURITY THEN _
LOGON.ERROR.INDEX = 1 : _
GOTO 460
IF FIRST.NAME$ = LAST.NAME$ THEN _
LOGON.ERROR.INDEX = 3 : _
GOTO 10620
IF NOT REMEMBER.NEW.USERS THEN _
GOSUB 13700 : _
USER.FILE.INDEX = 0 : _
GOSUB 12960: _
PREV.LAST.ON$ = "00-00-00": _
GOTO 735
NEW.USER = TRUE
CALL OPENUSER (HIGHEST.USER.RECORD)
GOSUB 9450
GOSUB 12630
MID$(USER.RECORD$,START.HASH,LEN.HASH) = LEFT$("NEWUSER",LEN.HASH)
IF START.INDIV>0 THEN _
MID$(USER.RECORD$,START.INDIV,LEN.INDIV) = INDIV.VALUE$
GOSUB 9440
730 GOSUB 12960
735 BYPASS.TIME.CHECK = TRUE
CALL ASKMORE ("",TRUE,TRUE,X,TRUE)
FILE.NAME$ = NEWUSER.FILE$
STOP.INTERRUPTS = TRUE
GOSUB 1790
CALL SKIPLINE(1)
739 CALL QTPUT(ACTIVE.USER.NAME$ + " from " + CI$,1)
740 A$ = "C)hange name/address, D)isconnect, [R]egister"
GOSUB 12995
IF Q = 0 THEN _
Z$ = "R" _
ELSE CALL ALLCAPS (B$(1)) : _
Z$ = B$(1)
S = INSTR("CDR",Z$)
745 IF NOT REMEMBER.NEW.USERS THEN _
ON S GOTO 748,752,754
ON S GOTO 747,750,760
GOTO 740
747 CALL UPDTCALR (ACTIVE.USER.NAME$ + " from " + CI$ + _
" changed Name/Address",2)
MID$(USER.RECORD$,START.HASH,LEN.HASH) = STRING$(LEN.HASH,0)
GOSUB 9440
GOSUB 12991
748 FF = FALSE
GOTO 400
'
' *** D - COMMAND FROM NEWUSER ROUTINE (DISCONNECT - REFUSE TO REGISTER) ***
'
750 CALL UPDTCALR (ACTIVE.USER.NAME$ + " from " + CI$ + _
" didn't register",2)
MID$(USER.RECORD$,START.HASH,LEN.HASH) = STRING$(LEN.HASH,0)
GOSUB 9440
GOSUB 12991
752 FF = FALSE
USER.FILE.INDEX = 0
GOTO 13540
'
' ***** GET AND VERIFY PASSWORD *****
'
754 CALL QTPUT ("GUEST privileges granted. RE-REGISTER on future calls",1)
USER.SECURITY.SAVE = USER.SECURITY.LEVEL
GOTO 832
755 IF PRIVATE.DOOR THEN _
B$ = PASSWORD$ : _
Z$ = B$ : _
RETURN
GOSUB 12800
A$ = "Re-enter PASSWORD for verification (Dots Echo)"
GOSUB 45010
SWAP Z$,B$
CALL ALLCAPS (Z$)
IF B$ <> Z$ THEN _
CALL QTPUT ("Passwords Don't match!",1) : _
GOTO 755
RETURN
'
' *** R - COMMAND FROM NEWUSER ROUTINE - REGISTER ***
'
760 GOSUB 755
CALL ALLCAPS (Z$)
LSET PASSWORD$ = Z$
CALL QTPUT("Please REMEMBER your password",1)
USER.TEXT.COLOR = 37
TEMP.SECURITY.LEVEL = USER.SECURITY.LEVEL
CALL PROTOCOL
USER.TRANSFER.DEFAULT$ = "N"
PROTO.PROMPT$ = "None"
IF NEWUSER.SETS.DEFAULTS THEN _
GOSUB 42950 : _
BYPASS.TIME.CHECK = TRUE : _
GOSUB 43000 : _
BYPASS.TIME.CHECK = FALSE : _
CALL GRAPHIC (USER.GRAPHIC.DEFAULT$) : _
GOSUB 42805 : _
GOSUB 42700 _
ELSE UPPER.CASE = FALSE : _
CALL SETUGD (0,USER.GRAPHIC.DEFAULT$) : _
NULLS = FALSE
GOSUB 12900
GOSUB 5135
CALL DEFAULTU
FILE.NAME$ = NEW.USER.QUESTIONNAIRE$
GOSUB 11520
LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL)
'
' **** LOGIN ALL USERS ****
'
800 IF ORIG.CONFIG$ = CURRENT.DEF$ THEN _
MAIN.USER.FILE.INDEX = USER.FILE.INDEX : _
USER.SECURITY.SAVE = USER.SECURITY.LEVEL : _
ORIG.USER.NAME$ = ACTIVE.USER.NAME$
TIMES.LOGGED.ON = CVI(MID$(USER.OPTIONS$,1,2)) - _
(ORIG.CONFIG$ <> CURRENT.DEF$ OR NOT SUB.BOARD)
GOSUB 9500
PREV.LAST.ON$ = LAST.DATE.TIME.ON$
IF LOCAL.USER THEN _
TALK.TO.MODEM.AT$ = "9600" : _
BAUD.PARITY$ = "9600 BAUD,N,8,1" : _
MODEM.INIT.BAUD$ = "9600" : _
SNOOP = TRUE : _
LINE.FEEDS = TRUE
CALL SETCRLF
CALL CALLOPT
CALL XFERTYPE (2,TRUE)
IF NOT SUB.BOARD THEN _
BOARD.CHECK.DATE$ = PREV.LAST.ON$
IF PRIVATE.DOOR OR SUB.BOARD THEN _
GOTO 815
GOSUB 465
IF (EIGHT.BIT AND _
AUTODOWNLOAD.DESIRED) OR _
ASK.IDENTITY THEN _
CALL TESTUSER
CALL QTPUT ("Logging " + ACTIVE.USER.NAME$,1)
CALL QTPUT ("RBBS-PC " + VERSION.ID$ + " NODE " + NODE.ID$ + _
", OPERATING AT " + BAUD.PARITY$,1)
CALL SKIPLINE (1)
ATTEMPTS = 0
'
' ***** NOTIFY THE CALLER IF THEY ARE ABLE TO USE "AUTODOWNLOADING" ****
'
IF EIGHT.BIT AND AUTODOWNLOAD.AVAILABLE THEN _
A$ = CHR$(9) + _
RETURN.LINE.FEED$ + _
"You may use AUTODOWNLOADing!" : _
CALL RINGCALLER : _
CALL DELAYIT(4)
815 DOWNLOADS = CVI(USER.DOWNLOADS$)
UPLOADS = CVI(USER.UPLOADS$)
IF ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _
DL.TODAY! = CVS(TODAY.DL$) : _
BYTES.TODAY! = CVS(TODAY.BYTES$) : _
DLBYTES! = CVS(DL.BYTES$) : _
ULBYTES! = CVS(UL.BYTES$)
IF CURRENT.DATE$ <> LEFT$(LAST.DATE.TIME.ON.SAVE$,8) THEN _
DL.TODAY! = 0 : _
BYTES.TODAY! = 0
IF RATIO.RESTRICTION# > 0 AND ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _
IF BYTE.METHOD = 0 AND UPLOADS < INITIAL.CREDIT# THEN _
UPLOADS = INITIAL.CREDIT# _
ELSE IF BYTE.METHOD = 1 AND ULBYTES! < INITIAL.CREDIT# THEN _
ULBYTES! = INITIAL.CREDIT#
LAST.MESSAGE.READ = -LAST.MESSAGE.READ * (LAST.MESSAGE.READ <= HIGH.MESSAGE.NUMBER)
LSET USER.OPTIONS$ = MKI$(TIMES.LOGGED.ON) + _
MID$(USER.OPTIONS$,3)
LSET LAST.DATE.TIME.ON$ = CURRENT.DATE$ + _
" " + _
TIME.LOGGED.ON$
MID$(USER.RECORD$,START.HASH,LEN.HASH) = HASH.VALUE$
IF START.INDIV > 0 THEN _
MID$(USER.RECORD$,START.INDIV,LEN.INDIV) = INDIV.VALUE$
LSET USER.NAME$ = ORIG.USER.NAME$
IF (NOT EXIT.TO.DOORS) AND NOT (ORIG.MESSAGE.FILE$ = ACTIVE.MESSAGE.FILE$ AND SUB.BOARD) THEN _
CALL AUTOPAGE
IF NOT SUB.BOARD THEN _
ORIG.USER.FILE.INDEX = USER.FILE.INDEX
GOSUB 9440
GOSUB 12991
CALL ASKMORE ("",TRUE,TRUE,X,TRUE)
IF TURBO.LOGON THEN _
GOTO 821
IF NOT SAME.USER THEN _
STOP.INTERRUPTS = NOT WELCOME.INTERRUPTABLE : _
BYPASS.TIME.CHECK = TRUE : _
FILE.NAME$ = WELCOME.FILE$ : _
DISPLAY.AS.UNIT = TRUE : _
GOSUB 1790 : _
DISPLAY.AS.UNIT = FALSE
BYPASS.TIME.CHECK = FALSE
STOP.INTERRUPTS = TRUE
816 IF NOT NEW.USER THEN _
CALL QTPUT("Times on:" + STR$(TIMES.LOGGED.ON) + _
" Last was: " + PREV.LAST.ON$,1)
817 IF NOT REMIND.FILE.TRANSFERS OR NEW.USER THEN _
GOTO 818
IF NOT ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _
A$ = "Files Downloaded:" + _
STR$(DOWNLOADS) + _
" Uploaded:" + _
STR$(UPLOADS) : _
GOSUB 12977 : _
GOTO 818
CALL CHECKRATIO (FALSE)
818 CALL ASKMORE ("",TRUE,TRUE,X,TRUE)
IF REMIND.PROFILE THEN _
GOSUB 5400 : _
CALL ASKMORE ("",TRUE,TRUE,X,TRUE)
821 CALL TRIM (CI$)
GOSUB 5370
IF A THEN _
ACTIVE.USER.NAME$ = "SYSOP"
GOSUB 4910
GOSUB 24000
GET 1,NODE.RECORD.INDEX
MID$(MESSAGE.RECORD$,1,31) = ACTIVE.USER.NAME$ + _
SPACE$(31 - LEN(ACTIVE.USER.NAME$))
MID$(MESSAGE.RECORD$,40,2) = " 0"
MID$(MESSAGE.RECORD$,44,2) = STR$(BPS)
MID$(MESSAGE.RECORD$,55,2) = " 0"
MID$(MESSAGE.RECORD$,57,1) = "A"
MID$(MESSAGE.RECORD$,60,5) = TALK.TO.MODEM.AT$ + _
SPACE$(5 - LEN(TALK.TO.MODEM.AT$))
MID$(MESSAGE.RECORD$,72,2) = " 0"
MID$(MESSAGE.RECORD$,93,24) = CI$ + _
SPACE$(24)
PUT 1,NODE.RECORD.INDEX
GOSUB 12985
IF EXIT.TO.DOORS THEN _
IF TRANSFER.FUNCTION = 3 THEN _
TRANSFER.FUNCTION = 0 : _
GOTO 832 _
ELSE GOTO 832
IF NOT NEW.USER THEN _
GOTO 832
Z$ = REGISTRATION.PROGRAM$
TRANSFER.FUNCTION = 3
CALL DOOREXIT
TRANSFER.FUNCTION = 0 3
GOTO 832
'
' **** ESC PRESSED ON LOCAL CONSOLE ENTERS HERE ****
'
822 LOCATE 24,1
CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
LOCAL.USER = TRUE
SNOOP = TRUE
WAIT.BEFORE.DISCONNECT = 32400
BPS = -6
CALL COMMINFO
CALL MUZAK (2)
IF NOT ESCAPE.INSECURE THEN _
GOTO 345
ACTIVE.USER.NAME$ = SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$
FIRST.NAME$ = SYSOP.PASSWORD.1$
LAST.NAME$ = SYSOP.PASSWORD.2$
CALL FINDTIME (USER.LOGON.TIME!)
GOTO 457
832 IF REG.DAYS.REMAINING <= DAYS.TO.WARN AND _
RESTRICT.BY.DATE AND REG.DAYS.REMAINING > 0 THEN _
CALL QTPUT ("Registration EXPIRES in" + _
STR$(REG.DAYS.REMAINING) + " days!",1) : _
CALL DELAYIT (5)
IF (NOT REQ.QUES.ANSWERED) AND _
REQUIRED.QUESTIONNAIRE$ <> "" THEN _
FILE.NAME$ = REQUIRED.QUESTIONNAIRE$ : _
GOSUB 11520 : _
IF OK THEN _
REQ.QUES.ANSWERED = TRUE
837 Z$ = ACTIVE.USER.NAME$ + _
" on at " + _
CURRENT.DATE$ + _
", " + _
TIM$ + _
" from " + _
CI$ + _
", " + _
BAUD.PARITY$
NG$ = Z$ + SPACE$(128 - LEN(Z$))
MESSAGE.USER.NAME$ = LEFT$(ACTIVE.USER.NAME$,22)
'
' * ALWAYS RECORD THE HASH/INDIVIDUATING FIELD TO EACH RECORD LOGGED OUT *
'
X$ = "{" + _
HASH.VALUE$ + _
"/" + _
INDIV.VALUE$ + _
"}"
IF LEN(Z$) < 65 THEN _
X = 65 _
ELSE X = LEN(Z$) + 2
MID$(NG$,X) = X$
CALL PRINTIT (" " + Z$)
IF NEW.USER THEN _
CALL UPDTCALR ("NEWUSER",1) : _
CALL MUZAK (2)
842 X = (MAX.PER.DAY - MINUTES.PER.SESSION!)
X = -X * (X > 0) ' extra from daily max
Q! = X + MINUTES.PER.SESSION! + (MAX.PER.DAY > 0) * ELAPSED.TIME
IF Q! > MINUTES.PER.SESSION! THEN _
Q! = MINUTES.PER.SESSION!
SECONDS.PER.SESSION! = (Q! - MINUTES.IN.DOORS)* 60 + TIME.CREDITS!
SYSOP = (USER.SECURITY.LEVEL >= SYSOP.SECURITY.LEVEL)
GOSUB 12987
IF SUB.BOARD THEN _
GOTO 850
CALLS.TODATE! = CALLS.TODATE! + 1 + SYSOP
850 SUBROUTINE.PARAMETER = 2
CALL LINE25
CALL SKIPLINE (1)
IF TURBO.LOGON THEN _
GOTO 900
CALL CTNEWFILES (BOARD.CHECK.DATE$,M(),LAST.NEW,A$)
IF FMS.DIRECTORY$ <> "" THEN _
CALL QTPUT(A$ + STR$(LAST.NEW) + " NEW file(s) since last on",1) _
ELSE GOTO 852
IF NEW.USER OR LAST.NEW < 1 OR NOT NEW.FILES.CHECK THEN _
GOTO 852
L = LEN(DOWNLOAD.DRIVES$)
OSS = 19
IF (NOT SKIP.FILES.LOGON) AND _
(USER.SECURITY.LEVEL >= MIN.SEC.TO.VIEW) AND _
USER.SECURITY.LEVEL >= OPT.SEC(OSS) THEN _
A$ = "Review new files to download ([Y],N)" : _
GOSUB 12999 : _
IF NOT NO THEN _
Q = 3 : _
B$(2) = MID$(BOARD.CHECK.DATE$,1,2) + _
MID$(BOARD.CHECK.DATE$,4,2) + _
MID$(BOARD.CHECK.DATE$,7,2) : _
Y$ = B$(3) : _
CALL BRKFNAME (FMS.DIRECTORY$,DR$,Y$,X$,FALSE) : _
B$(3) = Y$ : _
TIME.LOCK.EXEMPT = TRUE : _
GOSUB 20185 : _
TIME.LOCK.EXEMPT = FALSE
852 STOP.INTERRUPTS = FALSE
IF USER.SECURITY.LEVEL < OPT.SEC (2) OR _
ACTIVE.BULLETINS < 1 OR _
SYSOP OR _
SAME.USER THEN _
GOTO 900
IF BULLETIN.MENU$ = BULLETIN.SAVE$ THEN _
GOTO 900
BULLETIN.SAVE$ = BULLETIN.MENU$
855 CALL ASKMORE ("",TRUE,TRUE,X,TRUE)
IF BULLETINS.OPTIONAL AND NOT NEW.USER THEN _
GOTO 856
STOP.INTERRUPTS = TRUE
NEW.USER = FALSE
GOSUB 9700
STOP.INTERRUPTS = FALSE
GOTO 900
856 IF NOT CHECK.BULLETIN.LOGON THEN _
ANS.INDEX = 0 : _
GOSUB 9760 : _
GOTO 900
CALL SKIPLINE (1)
A$ = "Skip the" + _
STR$(ACTIVE.BULLETINS) + _
" bulletins (Y,[N])"
GOSUB 12999
IF YES THEN _
GOTO 900
860 NEW.USER = FALSE
GOSUB 9700
900 NEW.USER = FALSE
ACTION.FLAG = (LOGON.MAIL.LEVEL$ = "S")
LOGON.MAIL.NEW = (LOGON.MAIL.LEVEL$ = "N")
GOSUB 1895
IF ACTIVE.USER.NAME$ = "SYSOP" AND NOT SYSOP THEN _
ACTIVE.USER.NAME$ = ORIG.USER.NAME$
LOGON.MAIL.NEW = FALSE
SUBROUTINE.PARAMETER = 2
CALL LINE25
SECTION$ = " "
A$ = ""
IF (NOT CONFERENCE.MODE ) AND (NOT SUB.BOARD) AND NOT TURBO.LOGON THEN _
GOSUB 5800
EXIT.TO.DOORS = FALSE
GOSUB 2350
IF NOT PRIVATE.DOOR THEN _
GOTO 955
GOSUB 20165
CALL SETSECT
PRIVATE.DOOR = FALSE
GOTO 1205
955 GOSUB 4850
TURBO.LOGON = FALSE
'
' * COMMAND PROCESSING *
'
1200 CLOSE 1
GOSUB 1280
1205 CHAT.AVAILABLE = TRUE
SUBROUTINE.PARAMETER = 1
STOP.INTERRUPTS = FALSE
NON.STOP = FALSE
Q = 0
IF HOME.CONFERENCE$ <> "" THEN _
TURBO.LOGON = TRUE : _
FF = 8 : _
B$(2) = HOME.CONFERENCE$ : _
HOME.CONFERENCE$ = "" : _
Q = 2 : _
GOTO 1240
CALL SKIPLINE (1)
1210 GOSUB 41000
CALL DISPLAYTR (TIME.REMAINING!)
IF EXPERT.USER THEN _
GOTO 1230
1212 LINES.PRINTED = -MENUS.CAN.PAUSE * LINES.PRINTED
IF CUSTOM.PUI THEN _
GOTO 1230
IF SUB.SECTION < BEG.FILE THEN _
IF SYSOP THEN _
FILE.NAME$ = MENU$(1) : _
GOSUB 43025
FILE.NAME$ = MENU$(MENU.INDEX)
DELETE.INVALID = TRUE
GOSUB 43025
DELETE.INVALID = FALSE
1230 CALL LINE25
CALL SKIPLINE (1)
IF CONFERENCE.MODE THEN _
A$ = GRN$ : _
GOSUB 12979
IF CUSTOM.PUI THEN _
CALL USERFACE (USER.GRAPHIC.DEFAULT$) : _
GOSUB 12997 : _
GOTO 1235
IF MENU.INDEX = 6 THEN _
SUBROUTINE.PARAMETER = 1 : _
CALL LIBRARY
A$ = COMMAND.PROMPT$
GOSUB 12999
IF Q = 0 THEN _
GOTO 1230
1235 Z$ = B$(1)
IF LEN(Z$) < 1 THEN _
GOTO 1230
CALL ALLCAPS (Z$)
CALL SRCHCMND (SUB.SECTION,FF)
IF FF < 1 THEN _
CALL QTPUT ("Unknown command <"+Z$+">",1) : _
GOTO 1230
1240 IF USER.SECURITY.LEVEL < OPT.SEC(FF) THEN _
VIOLATION$ = SECTION$ + _
" " + _
Z$ : _
GOSUB 1380 : _
GOTO 1205
IF FF > 39 THEN _
DIRECTORY.EXTENTION$ = LIBRARY.DIRECTORY.EXTENTION$ _
ELSE DIRECTORY.EXTENTION$ = MAIN.DIRECTORY.EXTENTION$
LAST.INDEX = Q
ANS.INDEX = 1 - (LAST.INDEX > 1)
ON FF GOSUB _
1400, _ ' 1 A)nswer questionnaire 1
9700, _ ' 2 B)ulletins
1800, _ ' 3 C)omments
10970, _ ' 4 D)oor (exit to)
2000, _ ' 5 E)nter a message
1275, _ ' 6 F)ile system (exit to)
1760, _ ' 7 I)nitial welcome redisplayed
5300, _ ' 8 J)oin a conference
3900, _ ' 9 K)ill a message
4700, _ '10 O)perator page
1900, _ '11 P)ersonal mail (look for)
4330, _ '12 R)ead messages
4340, _ '13 S)can message headers
4320, _ '14 T)opic msg scan
1285, _ '15 U)tilities (exit to)
5800, _ '16 V)iew a conference
9800, _ '17 W)ho's on other nodes displayed
1283, _ '18 @)Library (exit to) 18
20160, _ '19 D)ownload
10570, _ '20 G)oodbye
20155, _ '21 L)ist
20185, _ '22 N)ew
20180, _ '23 P)ersonal files
20175, _ '24 S)can
20170, _ '25 U)pload
20140, _ '26 V)iew ARC Contents
5500, _ '27 B)aud rate change 300==>450 1
9100, _ '28 C)lock (time & time on)
42850, _ '29 E)cho selection
42800, _ '30 F)ile transfer protocol
43000, _ '31 G)raphics
5200, _ '32 L)ines per page
10925, _ '33 M)essage margin
5110, _ '34 P)assword change
5400, _ '35 R)eview preferences
4850, _ '36 S)tatistics displayed
1500, _ '37 T)oggle
10090, _ '38 U)serlog displayed 12
30000, _ '39 A)rchive a Library disk 1
30100, _ '40 C)hange a Library disk
30200, _ '41 D)ownload Library files
10570, _ '42 G)oodbye
20155, _ '43 L)ist a Library directory
20175, _ '44 S)can a Library disk directory
20140, _ '45 V)iew arc contents 7
1325, _ '45 H)elp 1
1330, _ '46 ?)help
1250, _ '49 Q)uit
4240, _ '50 X)expert toggle on/off 4
10070, _ '51 1) List comments file 1
10090, _ '52 2) List callers file
10390, _ '53 3) Recover a message
10530, _ '54 4) Erase comments
11000, _ '55 5) User file maintenance
4130, _ '56 6) Toggle page bell on/off
10930 '57 7) Exit to DOS 2.x or above 7
GOTO 1205
'
' **** QUIT COMMAND (GLOBAL) ****
'
1250 IF Q > 1 THEN _
ANS.INDEX = 2: _
GOTO 1270
1260 ANS.INDEX = 1
IF EXPERT.USER THEN _
A$ = QUIT.PROMPT.EXPERT$ _
ELSE A$ = QUIT.PROMPT.NOVICE$
GOSUB 12999
IF Q = 0 THEN _
Q = 1: _
B$(1) = "M"
1270 Z$ = B$(ANS.INDEX)
CALL ALLCAPS (Z$)
IF Z$ = "C" THEN _
Z$ = "M" : _
GOTO 5323
ON INSTR(QUIT.LIST$,Z$) GOTO 1275,1280,1285,10570,1283
GOTO 1260
1275 MENU.INDEX = 3
GOTO 1295
1280 MENU.INDEX = 2
GOTO 1295
1283 MENU.INDEX = 6
ACTIVE.FMS.DIRECTORY$ = ""
GOTO 1295
1285 MENU.INDEX = 4
1295 CALL SETSECT
RETURN
1300 CALL QTPUT ("Message base " + GRN$,1)
RETURN
'
' **** COMMON LOCAL DISPLAY PRINT ****
'
1315 NUM.RETURNS = 1
1320 CALL LPRNT(D$,NUM.RETURNS)
RETURN
'
' ****** HELP (GLOBAL) *****
'
1325 CALL VIEWHELP (SUB.SECTION,USER.GRAPHIC.DEFAULT$, _
MID$("MAINFILEUTILMAINLIBR",4 * MENU.INDEX - 7,4))
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10595
RETURN
1330 IF EXPERT.USER THEN _
RETURN 1212
GOTO 1325
'
' ***** RECORD SECURITY VIOLATIONS *****
'
1380 CALL SVIOLATION
IF NOT DENY.ACCESS THEN _
RETURN
1386 CALL DENYACCESS
GOTO 10620
1397 A$ = "Sorry, " + _
FIRST.NAME$ + _
", " + _
A$
GOTO 12976
'
' *** END KEY - FORCE CURRENT USER OFF AND LOCK THEM OUT ***
'
1400 A1$ = ANS.MENU$
1401 CALL SUBMENU ("Which questionnaire(s), L)ist" + PRESS.ENTER.EXPERT$, _
A1$,QUES.PATH$,".DEF","",USER.GRAPHIC.DEFAULT$,TRUE,FALSE,TRUE)
IF Q = 0 THEN _
RETURN
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10595
QUESTIONNAIRE.HOLD$ = Z$
GOSUB 11520
CLOSE 2
CALL UPDTCALR (QUESTIONNAIRE.HOLD$ + " questionnaire " + _
MID$("answeredaborted",1 - 8 * QUESTIONNAIRE.ABORTED,8),2)
ANS.INDEX = ANS.INDEX + 1
IF ANS.INDEX > LAST.INDEX THEN _
ANS.INDEX = 0
GOTO 1401
'
' ***** TOGGLE COMMAND (UTILITIES) *****
'
1500 IF Q > 1 THEN _
ANS.INDEX = 2 : _
LAST.INDEX = Q : _
GOTO 1510
1502 ANS.INDEX = 1
A$ = "A)utodwnld B)ullet C)ase F)ile H)ilite"
CALL COLORPMT (A$)
CALL QTPUT (A$,1)
A$ = "L)ine feeds N)ulls T)urboKey X)pert !)bell"
CALL COLORPMT (A$)
CALL QTPUT (A$,1)
A$ = "TOGGLE which options on/off?" + PRESS.ENTER$
GOSUB 12999
IF Q=0 THEN _
RETURN
LAST.INDEX = Q
1510 Z$ = B$(ANS.INDEX)
CALL ALLCAPS (Z$)
FF = INSTR("ABCFHLNTX!",Z$)
IF FF < 1 THEN _
GOTO 1502
CALL TOGGLE (FF)
IF SUBROUTINE.PARAMETER < 0 THEN _
GOTO 202
ANS.INDEX = ANS.INDEX + 1
IF ANS.INDEX > LAST.INDEX THEN _
GOTO 1502
GOTO 1510
'
' **** I - COMMAND FROM MAIN MENU (DISPLAY INITIAL WELCOME) ****
'
1760 FILE.NAME$ = WELCOME.FILE$
1765 GOSUB 1790
RETURN
1790 CALL GRAPHIC (USER.GRAPHIC.DEFAULT$)
CALL BUFFILE (FILE.NAME$,X)
CALL CARRIER
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10595
RETURN
'
' *** C - COMMAND FROM MAIN MENU (LEAVE COMMENT FOR SYSOP) ***
'
1800 MESSAGE.TO$ = "SYSOP"
SUBJECT$ = "COMMENT"
GOSUB 1893
IF (ACTIVE.MESSAGES >= MAXIMUM.MESSAGES OR _
NEXT.MESSAGE.RECORD + 5 > HIGHEST.MESSAGE.RECORD OR _
NOT COMMENTS.AS.MESSAGES ) THEN _
A$ = "Want a REPLY? Use "+MID$(ALL.OPTS$,5,1)+" instead. Leave a comment? (Y/[N])" : _
GOSUB 12999 : _
IF NOT YES THEN _
CALL SKIPLINE (1) : _
RETURN _
ELSE SYSOP.COMMENT = TRUE : _
GOTO 2007
SYSOP.COMMENT = FALSE
SYSOP.MESSAGE = TRUE
FT$ = "comment"
GOTO 2010
1850 BX = &H3
EN$ = COMMENTS.FILE$
GOSUB 12992
CALL OPENWRKA (COMMENTS.FILE$)
A$ = FIRST.NAME$ + _
", Thanks for comments!"
GOSUB 12976
SUBROUTINE.PARAMETER = 2
CALL AMORPM
CALL PRNTWRKA (ACTIVE.USER.NAME$+" "+CURRENT.DATE$+" "+TIM$+" Node "+NODE.ID$)
FOR X = 1 TO LINES.IN.MESSAGE
CALL PRNTWRKA (A$(X))
NEXT
CALL PRNTWRKA (CARRIAGE.RETURN$)
CLOSE 2
IF EC <> 0 THEN _
EL = 1850 : _
GOTO 13000
BX = &H3
EN$ = COMMENTS.FILE$
GOSUB 12993
CALL UPDTCALR ("Left comment",1)
REDIM A$(ADIM)
RETURN
'
' **** P - COMMAND FROM MAIN MENU (DISPLAY PERSONAL MAIL) *****
'
1893 ACTION.FLAG = TRUE
GOTO 1897
1895 IF TURBO.LOGON THEN _
RETURN
B$(0) = LEFT$("NEW ",-4*LOGON.MAIL.NEW)
1897 IF ACTIVE.MESSAGE.FILE$ = PREV.BASE$ THEN _
ACTION.FLAG = FALSE : _
RETURN
1900 GOSUB 5344
IF PRIVATE.DOOR THEN _
ACTION.FLAG = TRUE
PREV.BASE$ = ACTIVE.MESSAGE.FILE$
SHOW.ACTIVE = FALSE
IF NOT ACTION.FLAG THEN _
CALL QTPUT ("Checking messages in " + GRN.NAME$,0) : _
SHOW.ACTIVE = TRUE _
ELSE CALL QTPUT ("Loading messages",0) : _
FOR I = 1 TO Q: _
A$(I) = B$(I) : _
NEXT
I = 0
MESSAGES.FROM.USER = FALSE
ACTIVE.MESSAGES = 0
MAIL.REPORTED = ACTION.FLAG
FIRST.OLD = TRUE
GOSUB 23000
MESSAGE.RECORD = FIRST.MESSAGE.RECORD
ACTIVE.DELAY! = 0
MAXIMUM.MESSAGES = VAL(MID$(MESSAGE.RECORD$,89,7))
IF MAXIMUM.MESSAGES > MM THEN _
MAXIMUM.MESSAGES = MM
REDIM M(MAXIMUM.MESSAGES,2)
NUM.DOTS = 0
1905 GET 1,MESSAGE.RECORD
CALL CHECKINT (MID$(MESSAGE.RECORD$,117,4))
IF EC <> 0 THEN _
EL = 1905 : _
GOTO 13000
NUMBER.RECORDS.IN.MESSAGE = VAL(MID$(MESSAGE.RECORD$,117,4))
IF NUMBER.RECORDS.IN.MESSAGE < 1 THEN _
NUMBER.RECORDS.IN.MESSAGE = 1
1906 IF ACTION.FLAG OR (FIRST.OLD AND NOT MAIL.REPORTED) THEN _
CALL MARKTIME (NUM.DOTS)
CALL CARRIER
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10595
1910 IF MESSAGE.RECORD >= NEXT.MESSAGE.RECORD THEN _
LOW.MESSAGE.NUMBER = M(1,2) : _
GOTO 1950
1915 IF MID$(MESSAGE.RECORD$,116,1) = DELETED.MESSAGE$ OR _
MID$(MESSAGE.RECORD$,116,1) <> ACTIVE.MESSAGE$ THEN _
GOTO 1946
X$ = MID$(MESSAGE.RECORD$,121,2)
IF X$ <> " " THEN _
IF CVI(X$) > USER.SECURITY.LEVEL THEN _
GOTO 1945
IF ACTION.FLAG THEN _
GOTO 1935
'
' ** ALLOW USERS WITH NAMES LONGER THAN 22 CHARS TO RECEIVE PRIVATE MAIL **
'
1920 X$ = MID$(MESSAGE.RECORD$,37,22)
IF INSTR(X$,MESSAGE.USER.NAME$) OR _
(SYSOP AND INSTR(X$,"SYSOP")) OR _
(SYSOP AND INSTR(X$,SYSOP.FULL.NAME$)) THEN _
GOTO 1925
GOTO 1935
1925 A = VAL(MID$(MESSAGE.RECORD$,2,4))
IF LOGON.MAIL.NEW THEN _
IF A <= LAST.MESSAGE.READ THEN _
GOTO 1935
IF NOT SHOW.ACTIVE THEN _
GOTO 1930
MAIL.REPORTED = TRUE
FIRST.NEW = (A > LAST.MESSAGE.READ)
IF FIRST.NEW THEN _
I = 0 : _
CALL SKIPLINE (1) : _
CALL QTPUT("NEW Mail for YOU (* = Private)",1) _
ELSE IF FIRST.OLD THEN _
CALL SKIPLINE (1) : _
CALL QTPUT ("OLD Mail for YOU (* = Private)",1) : _
FIRST.OLD = FALSE
SHOW.ACTIVE = NOT FIRST.NEW
1930 CALL QTPUT (LEFT$(MESSAGE.RECORD$,5),0)
I = I + 1
IF I MOD 15 = 0 THEN _
CALL SKIPLINE (1)
1935 IF INSTR(MID$(MESSAGE.RECORD$,6,31),ACTIVE.USER.NAME$) OR _
(SYSOP AND INSTR(MID$(MESSAGE.RECORD$,6,31),"SYSOP")) OR _
(SYSOP AND INSTR(MID$(MESSAGE.RECORD$,6,31),SYSOP.FIRST.NAME$ + " " + SYSOP.LAST.NAME$)) THEN _
GOTO 1940
GOTO 1945
1940 IF MESSAGES.FROM.USER < ADIM THEN _
MESSAGES.FROM.USER = MESSAGES.FROM.USER + 1 : _
B$(MESSAGES.FROM.USER) = LEFT$(MESSAGE.RECORD$,5)
1945 ACTIVE.MESSAGES = ACTIVE.MESSAGES + 1
M(ACTIVE.MESSAGES,1) = MESSAGE.RECORD
M(ACTIVE.MESSAGES,2) = VAL(MID$(MESSAGE.RECORD$,2,4))
1946 MESSAGE.RECORD = MESSAGE.RECORD + NUMBER.RECORDS.IN.MESSAGE
GOTO 1905
1950 IF NOT MAIL.REPORTED THEN _
A$ = "Sorry, " + _
FIRST.NAME$ + _
", NO " + B$(0) + "MAIL for you" : _
GOSUB 12975
IF MESSAGES.FROM.USER = 0 OR NOT MESSAGE.REMINDER THEN _
GOTO 1961
IF ACTION.FLAG THEN _
GOTO 1961
A$ = "Mail you left"
GOSUB 12976
1960 FOR I = 1 TO MESSAGES.FROM.USER
A$ = B$(I)
GOSUB 12978
IF I MOD 15 = 0 THEN _
CALL SKIPLINE (1)
NEXT
CALL SKIPLINE (1)
CALL QTPUT("Please <K>ill old/unneeded messages",1)
1961 REDIM B$(ADIM)
IF ACTION.FLAG THEN _
ACTION.FLAG = FALSE : _
FOR I = 1 TO Q : _
B$(I) = A$(I) : _
A$(I) = "" : _
NEXT
CALL SKIPLINE (1)
RETURN
'
' **** E - COMMAND FROM MAIN MENU (ENTER MESSAGE) ****
'
2000 IF LOW.MESSAGE.NUMBER > 0 AND _
ACTIVE.MESSAGES = MAXIMUM.MESSAGES THEN _
IF ACTIVE.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$ AND _
ACTIVE.MESSAGES = 1 THEN _
GOTO 5300 _
ELSE A$ = "No room for new messages! Try tomorrow" : _
GOSUB 12975 : _
GOTO 3650
2006 MESSAGE.PASSWORD$ = ""
SYSOP.COMMENT = FALSE
IF NOT REPLY THEN _
MESSAGE.TO$ = ""
2007 IF SYSOP.COMMENT THEN _
Z$ = COMMENTS.FILE$ : _
FT$ = "comment" _
ELSE Z$ = ACTIVE.MESSAGE.FILE$ : _
FT$ = "message"
2008 IF SYSOP.COMMENT THEN _
CALL FINDFREE : _
GOTO 2009
FREE.SPACE$ = "2000"
IF NEXT.MESSAGE.RECORD + 3 >= HIGHEST.MESSAGE.RECORD THEN _
FREE.SPACE$ = "1"
2009 IF VAL(FREE.SPACE$) < 2000 THEN _
A$ = "No room for " + _
FT$ : _
GOSUB 12979 : _
GOTO 3650
2010 LINES.IN.MESSAGE = 0
COMMPORT.STACK$ = ""
L = 0
X = 0
REDIM A$(ADIM)
IF GET.EXT.DESC THEN _
GOTO 2100
GOSUB 1893
IF SYSOP.COMMENT THEN _
GOTO 2100
IF SYSOP.MESSAGE THEN _
SYSOP.MESSAGE = FALSE : _
MESSAGE.PASSWORD$ = "^READ^" : _
GOTO 2100
RECEIVER.RECORD.NUM = 0
2020 CALL MSGTO (HIGHEST.USER.RECORD,MESSAGE.TO$,RECEIVER.RECORD.NUM,FOUND)
IF REPLY THEN _
FOUND = TRUE : _
CALL TRIM (MESSAGE.TO$): _
GOTO 2035 _
ELSE SUBJECT$ = ""
IF MESSAGE.TO$ = "" THEN _
RETURN
GOSUB 2065
2035 CALL MSGPROT (MESSAGE.TO$,FOUND,MESSAGE.PASSWORD$)
IF MESSAGE.PASSWORD$ = "" THEN _
GOTO 2020
GOTO 2100
'
' ***** SET/CHANGE SUBJECT FOR A MESSAGE ****
'
2065 IF SUBJECT$ <> "" THEN _
A$ = "Change SUBJECT from " + _
SUBJECT$ + _
" to" : _
GOSUB 12995 _
ELSE A$ = "Subject" : _
GOSUB 12998
IF LEN(B$) > 25 THEN _
A$ = "25 Char. Max" : _
GOSUB 12979 : _
GOTO 2065
IF Q = 0 THEN _
IF SUBJECT$ <> "" THEN _
RETURN _
ELSE GOSUB 2435 : _
IF YES THEN _
RETURN 5160 _
ELSE GOTO 2065
SUBJECT$ = B$
CALL ALLCAPS (SUBJECT$)
RETURN
'
' ***** ENTER MAIN BODY OF MESSAGE *****
'
2100 A$ = "Type " + _
FT$ + _
STR$(MAX.MESSAGE.LINES) + _
" lines max" + _
PRESS.ENTER$
GOSUB 12975
GOSUB 3200
2125 LINES.IN.MESSAGE = LINES.IN.MESSAGE + 1
2127 IF REMOTE.ECHO OR LOCAL.USER THEN _
A$ = RIGHT$(STR$(LINES.IN.MESSAGE),2) + _
": " + _
A$(LINES.IN.MESSAGE) _
ELSE A$ = A$(LINES.IN.MESSAGE)
GOSUB 12978
CALL LINEEDIT(LINES.IN.MESSAGE,RIGHT.MARGIN + 1)
IF WAIT.EXPIRED THEN _
GOTO 10590 _
ELSE IF SUBROUTINE.PARAMETER = -1 THEN _
GOTO 10595
CALL FINDFUNC
IF SUBROUTINE.PARAMETER < 0 THEN _
GOTO 202
IF A$(LINES.IN.MESSAGE) = "" THEN _
LINES.IN.MESSAGE = LINES.IN.MESSAGE - 1 : _
GOTO 2300
2140 J = LINES.IN.MESSAGE
GOSUB 2200
IF X THEN _
GOTO 2300
GOTO 2125
2200 X = 0
IF J < (MAX.MESSAGE.LINES - 2) THEN _
RETURN
A$ = MID$("2 lines leftLast line Full",12 * (J-(MAX.MESSAGE.LINES - 2)) + 1,12)
X = (J > (MAX.MESSAGE.LINES - 1))
2210 GOSUB 12979
RETURN
'
' ***** FINAL MESSAGE DISPOSITION *****
'
2300 CALL SKIPLINE (1)
IF NOT EXPERT.USER THEN _
CALL QTPUT ("A)bort," + LEFT$("B)tch Import,",-13 * (SYSOP OR LOCAL.USER)) + "C)ont,D)el,E)dit,I)nsert,L)ist,M)argin,R)ev subj,S)ave",1)
2315 A$ = "Edit Sub-function <A," + _
LEFT$("B,",-2 * (SYSOP OR LOCAL.USER)) + _
"C,D,E,I,L,M,R,S,?>"
CALL SKIPLINE (1)
GOSUB 12999
IF Q = 0 THEN _
GOTO 2315
CALL ALLCAPS (B$(1))
Z$ = B$(1)
2325 IF Q > 1 AND Z$ <> "M" THEN _
CALL CHECKINT (B$(Q)) : _
IF EC <> 0 THEN _
GOTO 2300 _
ELSE L = TESTED.INTEGER.VALUE : _
GOSUB 3320
2330 ON INSTR("ABCDEILMRS?",Z$) GOTO 2400,2335,2332,2500,2600,2800,3000,3100,2440,3400,2345
GOTO 2300
2332 IF LINES.IN.MESSAGE < 1 THEN _
LINES.IN.MESSAGE = 1
GOTO 2127
2335 X = LINES.IN.MESSAGE
CALL MIMPORT (MAX.MESSAGE.LINES,RIGHT.MARGIN,LINES.IN.MESSAGE,A$())
IF LINES.IN.MESSAGE > X THEN _
GOTO 3000 _
ELSE GOTO 2300
'
' ***** DISPLAY MESSAGE SUBCOMMANDS HELP FILE *****
'
2345 FILE.NAME$ = HELP$(4)
GOSUB 1790
GOTO 2315
2350 CALL FINDIT (MAIN.PUI$)
CUSTOM.PUI = OK
IF OK THEN _
CURRENT.PUI$ = MAIN.PUI$ _
ELSE CURRENT.PUI$ = ""
RETURN
'
' **** ABORT MESSAGE ****
'
2400 GOSUB 2435
IF NOT YES THEN _
GOTO 2300
2430 A$ = "Aborted"
GOSUB 12975
GOTO 3650
2435 A$ = "Abort " + _
FT$ + _
" (Y/[N])"
GOSUB 12995
RETURN
'
' ***** CHANGE SUBJECT OF A MESSAGE *****
'
2440 GOSUB 2065
GOTO 2300
'
' ***** DELETE MESSAGE LINE *****
'
2500 CALL SKIPLINE (1)
IF Q = 1 THEN _
A$ = "Delete " : _
GOSUB 12978 : _
GOSUB 3300
2520 A$ = "Line #" + _
STR$(L)
GOSUB 12979
A$ = A$(L)
GOSUB 12977
A$ = "Delete this line (Y/[N])"
GOSUB 12995
IF NOT YES THEN _
A$ = "NOT Deleted" : _
GOSUB 12979 : _
GOTO 2300
2550 LINES.IN.MESSAGE = LINES.IN.MESSAGE - 1
FOR X = L TO LINES.IN.MESSAGE
A$(X) = A$(X + 1)
NEXT
A$(LINES.IN.MESSAGE + 1) = ""
A$ = "Deleted Line #" + _
STR$(L)
GOSUB 12979
GOTO 2300
'
' **** EDIT MESSAGE LINE ****
'
2600 CALL SKIPLINE (1)
IF Q = 1 THEN _
GOSUB 3300
CALL EDITALINE (L)
IF SUBROUTINE.PARAMETER < 0 THEN _
GOTO 202
GOTO 2300
2800 IF LINES.IN.MESSAGE >= MAX.MESSAGE.LINES AND NOT SYSOP THEN _
A$ = "Message full" : _
GOSUB 12979 : _
GOTO 2920
2820 CALL SKIPLINE (1)
IF Q = 1 THEN _
A$ = "Before " : _
GOSUB 12978 : _
GOSUB 3300
2830 LL = LINES.IN.MESSAGE
K = LINES.IN.MESSAGE - L
FOR X = L TO LINES.IN.MESSAGE
B$(X + 1 - L) = A$(X)
A$(X) = ""
NEXT
LINES.IN.MESSAGE = L
2840 A$ = RIGHT$(STR$(LINES.IN.MESSAGE),2) + _
": "
GOSUB 12978
CALL LINEEDIT(LINES.IN.MESSAGE,RIGHT.MARGIN + 1)
IF A$(LINES.IN.MESSAGE) = "" THEN _
GOTO 2920
2870 LINES.IN.MESSAGE = LINES.IN.MESSAGE + 1
J = LINES.IN.MESSAGE + K - 1
GOSUB 2200
IF NOT X THEN _
GOTO 2840
2920 FOR X = 1 TO K + 1
A$(LINES.IN.MESSAGE + X - 1) = B$(X)
NEXT
REDIM B$(ADIM)
LINES.IN.MESSAGE = LL + LINES.IN.MESSAGE - L
GOTO 2300
'
' ***** LIST MESSAGE CONTENTS *****
'
3000 STOP.INTERRUPTS = FALSE
CALL SKIPLINE (1)
IF Q = 1 THEN _
L = 1 : _
A$ = FG.3$ + "To: " + _
MESSAGE.TO$ + _
FG.4$ + " Re: " + _
SUBJECT$ + EMPHASIZE.OFF$ : _
GOSUB 12979 : _
CALL QTPUT (MID$(" ",1,-4 * (NOT REMOTE.ECHO)),0) : _
GOSUB 3200
3020 FOR X = L TO LINES.IN.MESSAGE
CALL ASKMORE ("",TRUE,TRUE,XX,FALSE)
IF NO OR RET THEN _
X = LINES.IN.MESSAGE + 1 _
ELSE A$ = RIGHT$(STR$(X),2) + _
": " + _
A$(X) : _
GOSUB 12979
NEXT
GOTO 2300
'
' ***** CHANGE MARGIN WIDTH *****
'
3100 CALL SKIPLINE (1)
IF Q <> 1 THEN _
B$(1) = B$(Q) : _
GOTO 3130
3115 A$ = "SET Right-Margin from" + _
STR$(RIGHT.MARGIN) + _
" TO (8...72)"
GOSUB 12995
IF LEN(B$(1)) > 2 THEN _
GOTO 3140
3130 X = VAL(B$(1))
IF X > 7 AND X < 73 THEN _
RIGHT.MARGIN = X : _
A$ = "Margin now" + _
STR$(RIGHT.MARGIN) : _
GOTO 3150
3140 A$ = "Invalid - Margin UNCHANGED"
3150 GOSUB 12979
IF UTILITY.MARGIN.CHANGE THEN _
RETURN
GOTO 2300
3200 A$ = "[" + _
STRING$(RIGHT.MARGIN - 2,45) + _
"]"
IF REMOTE.ECHO OR LOCAL.USER THEN _
A$ = " " + _
A$
GOSUB 12975
RETURN
3300 A$ = "Line #"
GOSUB 12995
IF LEN(B$(1)) > 3 THEN _
GOTO 3300
L = VAL(B$(1))
3320 IF L >= 1 AND L <= LINES.IN.MESSAGE THEN _
RETURN
3330 IF Q = 0 THEN _
RETURN 2300
3340 A$ = "No such line"
GOSUB 12979
RETURN 2300
'
' **** SAVE MESSAGE ****
'
3400 IF GET.EXT.DESC THEN _
SYSOP.COMMENT = FALSE : _
RETURN
IF SYSOP.COMMENT THEN _
SYSOP.COMMENT = FALSE : _
GOTO 1850
3405 GOSUB 4910
MESSAGE.RECORD.SAVE$ = MESSAGE.RECORD$
A$ = "Adding new msg #" + _
STR$(HIGH.MESSAGE.NUMBER + 1)
IF NOT LOCAL.USER THEN _
CALL UPDTCALR (A$,1)
GOSUB 12978
SL = 0
N$ = ""
IF LOW.MESSAGE.NUMBER = 0 THEN _
LOW.MESSAGE.NUMBER = 1 : _
HIGH.MESSAGE.NUMBER = 1 : _
GOTO 3410
HIGH.MESSAGE.NUMBER = HIGH.MESSAGE.NUMBER + 1
3410 ACTIVE.MESSAGES = ACTIVE.MESSAGES + 1
MESSAGE.NUMBER$ = STR$(HIGH.MESSAGE.NUMBER) + _
SPACE$(5 - LEN(STR$(HIGH.MESSAGE.NUMBER)))
IF MESSAGE.PASSWORD$ = "^READ^" THEN _
MID$(MESSAGE.NUMBER$,1,1) = "*" : _
SSS = PRIVATE.READ.SEC _
ELSE SSS = PUBLIC.READ.SEC
3460 MESSAGE.FROM$ = ACTIVE.USER.NAME$ + _
SPACE$(31 - LEN(ACTIVE.USER.NAME$))
MESSAGE.TO$ = MESSAGE.TO$ + _
SPACE$(31 - LEN(MESSAGE.TO$))
MID$(MESSAGE.TO$,23,8) = TIME$
SUBJECT$ = SUBJECT$ + _
SPACE$(25 - LEN(SUBJECT$))
MESSAGE.PASSWORD$ = MESSAGE.PASSWORD$ + _
SPACE$(15 - LEN(MESSAGE.PASSWORD$))
FOR J = 1 TO LINES.IN.MESSAGE
A$(J) = A$(J) + _
CHR$(227)
SL = SL + LEN(A$(J))
NEXT
IF SL MOD 128 = 0 THEN _
N$ = STR$(SL \ 128 + 1) _
ELSE N$ = STR$(SL \ 128 + 2)
3530 GET 1,NEXT.MESSAGE.RECORD
M(ACTIVE.MESSAGES,1) = NEXT.MESSAGE.RECORD
M(ACTIVE.MESSAGES,2) = HIGH.MESSAGE.NUMBER
LSET MESSAGE.RECORD$ = MESSAGE.NUMBER$ + _
MESSAGE.FROM$ + _
MESSAGE.TO$ + _
CURRENT.DATE$ + _
SUBJECT$ + _
MESSAGE.PASSWORD$ + _
ACTIVE.MESSAGE$ + _
N$ + _
SPACE$(4 - LEN(N$)) + _
MKI$(SSS)
PUT 1,NEXT.MESSAGE.RECORD
NEXT.MESSAGE.RECORD = NEXT.MESSAGE.RECORD + VAL(N$)
N$ = ""
NUM.DOTS = 0
FOR J = 1 TO LINES.IN.MESSAGE
CALL MARKTIME (NUM.DOTS)
N$ = N$ + _
A$(J)
IF LEN(N$) > 127 THEN _
LSET MESSAGE.RECORD$ = N$ : _
PUT 1 : _
N$ = MID$(N$,129)
3630 NEXT
IF LEN(N$) > 0 THEN _
LSET MESSAGE.RECORD$ = N$ : _
PUT 1
REDIM A$(ADIM)
3640 CALL SKIPLINE (1)
LSET MESSAGE.RECORD$ = MESSAGE.RECORD.SAVE$
GOSUB 24000
GOSUB 12985
' ---[ notify receiver that has new mail waiting ]---
IF RECEIVER.RECORD.NUM > 0 THEN _
SUIX = USER.FILE.INDEX : _
USER.RECORD.HOLD$ = USER.RECORD$ : _
USER.FILE.INDEX = RECEIVER.RECORD.NUM : _
GOSUB 12989 : _
GET 5, RECEIVER.RECORD.NUM : _
X = CVI(MID$(USER.RECORD$,57,2)) : _
MID$(USER.RECORD$,57,2) = MKI$(X OR 512) : _
PUT 5, RECEIVER.RECORD.NUM : _
GOSUB 12991 : _
USER.FILE.INDEX = SUIX : _
LSET USER.RECORD$ = USER.RECORD.HOLD$ : _
CALL QTPUT ("Receiver will be notified of new mail",1) : _
RECEIVER.RECORD.NUM = 0
3650 IF REPLY THEN _
REPLY = FALSE : _
GOTO 5344
IF GET.EXT.DESC THEN _
LINES.IN.MESSAGE = 0 : _
RETURN
RETURN 1200
'
' **** K - COMMAND FROM MAIN MENU (KILL MESSAGE) ****
'
3900 KILL.MESSAGE = FALSE
CALL SKIPLINE (1)
IF Q <> 1 THEN _
TEMP = 2 : _
GOTO 3935
3930 A$ = "Msg #(s) to Kill" + PRESS.ENTER.EXPERT$
GOSUB 12995
IF Q = 0 THEN _
RETURN
GOSUB 1893
TEMP = 1
3935 CALL CHECKINT (B$(TEMP))
IF EC <> 0 THEN _
GOTO 3930
MESSAGE.TO.KILL = TESTED.INTEGER.VALUE
3950 GOSUB 5344
CALL KILLMSG (MESSAGE.TO.KILL,ACTIVE.MESSAGES)
4040 IF TEMP < Q THEN _
TEMP = TEMP + 1 : _
GOTO 3935
IF KILL.MESSAGE THEN _
RETURN
GOTO 3930
'
' **** Sysop Available toggle
'
4130 SUBROUTINE.PARAMETER = -8
CALL FINDFUNC
SUBROUTINE.PARAMETER = 0
RETURN
'
' **** X)pert Toggle
'
4240 CALL TOGGLE(9)
RETURN
'
' **** T)opic - QUICK SCAN MESSAGES ****
'
4320 QUICK.SCAN.MESSAGES = TRUE
READ.MESSAGES = FALSE
SCAN.MESSAGES = FALSE
MSG.START = 76
MSG.END = 100
SEC.INDEX= 0
GOTO 4350
'
' **** R - COMMAND FROM MAIN MENU (READ MESSAGES) **** *
'
4330 QUICK.SCAN.MESSAGES = FALSE
READ.MESSAGES = TRUE
HIGHLITE.REC = -1
SCAN.MESSAGES = FALSE
MSG.START = 6
MSG.END = 100
IF LOCAL.USER.MODE OR NOT LOCAL.USER THEN _
IF READ.MSG.IN$ <> ACTIVE.MESSAGE.FILE$ THEN _
READ.MSG.IN$ = ACTIVE.MESSAGE.FILE$ : _
CALL UPDTCALR ("Read Messages in " + READ.MSG.IN$,1)
GOSUB 1300
GOTO 4350
'
' **** S - COMMAND FROM MAIN MENU (SCAN MESSAGE HEADERS) ****
'
4340 IF Q < 2 THEN _
GOSUB 1300
4345 QUICK.SCAN.MESSAGES = FALSE
READ.MESSAGES = FALSE
SCAN.MESSAGES = TRUE
MSG.START = 6
MSG.END = 100
SEC.INDEX = 0
'
' ** MESSAGE READ MAINLINE (QUICK SCAN, READ & SCAN) ALL USE THIS ROUTINE **
'
4350 SEARCH.HEADER$ = ""
4352 SEARCH.STRING$ = ""
GOSUB 1893
GOSUB 5344
Z$ = ""
FOR I = 2 TO Q
IF INSTR("Ss*",B$(I)) > 0 THEN _
B$(I) = MID$(STR$(LAST.MESSAGE.READ+1),2) + "+"
NEXT
4360 LG$(11) = Z$
MESSAGES.SELECTED.INDEX = 1
NUMBER.MESSAGES.SELECTED = Q
ADDRESSED.TO.USER = FALSE
TO.REQUESTED = FALSE
FROM.REQUESTED = FALSE
IF PAGE.LENGTH < 1 THEN _
NON.STOP = TRUE
4370 MESSAGES.SELECTED.INDEX = MESSAGES.SELECTED.INDEX + 1
4371 IF MESSAGES.SELECTED.INDEX <= NUMBER.MESSAGES.SELECTED THEN _
CALL CHECKINT (B$(MESSAGES.SELECTED.INDEX)) : _
IF EC <> 0 THEN _
EL = 4371 : _
GOTO 13000 _
ELSE CURRENT.MESSAGE = TESTED.INTEGER.VALUE : _
GOTO 4415
4380 NON.STOP = FALSE
A1$ = "Msg #" + _
STR$(LOW.MESSAGE.NUMBER) + _
"-" + _
MID$(STR$(M(ACTIVE.MESSAGES,2)),2) + _
" (H)elp, S)ince"
IF ADDRESSED.TO.USER OR TO.REQUESTED OR FROM.REQUESTED THEN _
Y$ = LEFT$("TO",-2*(TO.REQUESTED OR ADDRESSED.TO.USER)) + _
LEFT$("/",-ADDRESSED.TO.USER) + _
LEFT$("FROM",-4*(FROM.REQUESTED OR ADDRESSED.TO.USER)) : _
CALL QTPUT ("Only msgs "+Y$+" you. Read from what msg # (e.g. 1+,4010-)",1) _
ELSE A1$ = A1$ + _
", T)o,F)rom,M)ine"
IF SEARCH.STRING$ = "" THEN _
A1$ = A1$ + _
", or text" _
ELSE CALL QTPUT ("Only msgs with text " + SEARCH.STRING$ + ". Read from what msg #( e.g. 1+,4010-)",1)
4390 A$ = A1$ + ", [Q]uit)"
4400 GOSUB 12995
IF Q = 0 THEN _
RETURN
4402 IF LEN(B$(1)) = 1 THEN _
IF INSTR("Qq",B$) THEN _
RETURN _
ELSE IF INSTR("Hh",LEFT$(B$(1),1)) THEN _
FILE.NAME$ = HELP.PATH$ + "MR" + HELP.EXTENSION$ : _
GOSUB 1790 : _
GOTO 4390
MESSAGES.SELECTED.INDEX = 0
NUMBER.MESSAGES.SELECTED = Q
GOTO 4370
4415 FORWARD = FALSE
REVERSE = FALSE
IF LEN(B$(MESSAGES.SELECTED.INDEX)) = 1 THEN _
IF INSTR("Ss*",B$(MESSAGES.SELECTED.INDEX)) > 0 THEN _
CURRENT.MESSAGE = LAST.MESSAGE.READ + 1 : _
FORWARD = TRUE : _
GOTO 4430
4416 IF INSTR("Mm",B$(MESSAGES.SELECTED.INDEX)) THEN _
ADDRESSED.TO.USER = TRUE : _
GOTO 4370
A = INSTR("FfTt",B$(MESSAGES.SELECTED.INDEX))
IF A > 0 THEN _
TO.REQUESTED = (A > 2) : _
FROM.REQUESTED = (A < 3) : _
GOTO 4370
IF CURRENT.MESSAGE = 0 THEN _
IF SEARCH.HEADER$ <> "" THEN _
GOTO 4370 _
ELSE SEARCH.STRING$ = B$(MESSAGES.SELECTED.INDEX) : _
CALL ALLCAPS (SEARCH.STRING$) : _
CALL REMOVE (SEARCH.STRING$,CHR$(34) + CHR$(39)) : _
SEARCH.HEADER$ = SEARCH.STRING$ : _
GOTO 4370
CALL SKIPLINE (1)
4430 IF RIGHT$(B$(MESSAGES.SELECTED.INDEX),1) = "+" THEN _
FORWARD = TRUE
IF RIGHT$(B$(MESSAGES.SELECTED.INDEX),1) = "-" THEN _
REVERSE = TRUE : _
GOTO 4490
4450 MESSAGE.DIM.INDEX = 1
4452 IF MESSAGE.DIM.INDEX > ACTIVE.MESSAGES THEN _
GOTO 4515
IF READ.MESSAGES AND _
M(MESSAGE.DIM.INDEX,2) = CURRENT.MESSAGE THEN _
GOTO 4520
4470 IF ((READ.MESSAGES AND FORWARD) OR _
QUICK.SCAN.MESSAGES OR SCAN.MESSAGES) AND _
M(MESSAGE.DIM.INDEX,2) >= CURRENT.MESSAGE THEN _
GOTO 4520
4480 MESSAGE.DIM.INDEX = MESSAGE.DIM.INDEX + 1
GOTO 4452
4490 MESSAGE.DIM.INDEX = ACTIVE.MESSAGES
4492 IF MESSAGE.DIM.INDEX < 1 THEN _
GOTO 4515
IF M(MESSAGE.DIM.INDEX,2) <= CURRENT.MESSAGE THEN _
GOTO 4540
4510 MESSAGE.DIM.INDEX = MESSAGE.DIM.INDEX - 1
GOTO 4492
4515 A$ = "No such msg #" + _
STR$(CURRENT.MESSAGE)
GOSUB 12979
GOTO 4370
4520 ENDING.MESSAGE.INDEX = MESSAGE.DIM.INDEX
IF READ.MESSAGES AND NOT FORWARD THEN _
GOTO 4560
4530 STARTING.MESSAGE.INDEX = MESSAGE.DIM.INDEX
ENDING.MESSAGE.INDEX = ACTIVE.MESSAGES
SO = 1
GOTO 4550
4540 STARTING.MESSAGE.INDEX = MESSAGE.DIM.INDEX
ENDING.MESSAGE.INDEX = 1
SO = -1
4550 XXX = ENDING.MESSAGE.INDEX + SO
MESSAGE.DIM.INDEX = STARTING.MESSAGE.INDEX
4552 IF MESSAGE.DIM.INDEX = XXX THEN _
GOTO 4637
4560 CURRENT.HEADER = M(MESSAGE.DIM.INDEX,1)
IF CURRENT.HEADER < 1 THEN _
GOTO 4515
GET 1,CURRENT.HEADER
PASSWORD.FAILED = 0
UH = 0
Z$ = MID$(MESSAGE.RECORD$,101,15)
X = 1
4561 X$ = MID$(MESSAGE.RECORD$,X)
FF = INSTR(X$,MESSAGE.USER.NAME$)
IF FF > 0 THEN _
X = LEN(MESSAGE.USER.NAME$) _
ELSE IF SYSOP THEN _
FF = INSTR(X$,"SYSOP") : _
X = 5 : _
IF FF = 0 THEN _
X = LEN(SYSOP.FULL.NAME$) : _
FF = INSTR(X$,SYSOP.FULL.NAME$)
IF FF > 0 THEN _
X = X + FF : _
IF (FF < 7 OR MID$(MESSAGE.RECORD$,FF - 1,1) = " ") AND (X > 58 OR MID$(MESSAGE.RECORD$,X,1) = " ") THEN _
UH = TRUE _
ELSE IF FF < 37 THEN _
X = 37 : _
GOTO 4561
MSG.TO.CALLER = (UH AND (FF = 37)) OR _
(MID$(MESSAGE.RECORD$,37,4) = "ALL ")
MSG.FROM.CALLER = UH AND (FF = 6)
4562 IF NOT SYSOP THEN _
IF INSTR(MESSAGE.RECORD$,"^READ^") > 0 AND NOT UH THEN _
PASSWORD.FAILED = TRUE : _
IF FORWARD OR REVERSE THEN _
GOTO 4635
4563 CURRENT.MESSAGE = VAL(MID$(MESSAGE.RECORD$,2,4))
IF TO.REQUESTED THEN _
IF NOT MSG.TO.CALLER THEN _
GOTO 4625
IF FROM.REQUESTED THEN _
IF NOT MSG.FROM.CALLER THEN _
GOTO 4625
IF ADDRESSED.TO.USER AND NOT UH THEN _
GOTO 4625
X$ = MID$(MESSAGE.RECORD$,121,2)
IF X$ = " " THEN _
MESSAGE.SECURITY = MINIMUM.LOGON.SECURITY _
ELSE MESSAGE.SECURITY = CVI(X$)
IF USER.SECURITY.LEVEL < MESSAGE.SECURITY THEN _
GOTO 4625
4580 IF INSTR(MESSAGE.RECORD$,LG$(11)) = 0 THEN _
GOTO 4635
4581 IF MID$(MESSAGE.RECORD$,116,1) = DELETED.MESSAGE$ THEN _
GOTO 4630
JUST.SEARCHING = FALSE
IF SEARCH.HEADER$ <> "" THEN _
FF = INSTR(MESSAGE.RECORD$,SEARCH.HEADER$) : _
IF FF >= MSG.START AND FF <= MSG.END THEN _
HIGHLITE.POS = FF : _
GOTO 4582 _
ELSE IF READ.MESSAGES AND SEARCH.STRING$ <> "" THEN _
JUST.SEARCHING = TRUE : _
GOTO 4582 _
ELSE GOTO 4625
4582 PG = FALSE
IF MID$(Z$,1,1) = "!" THEN _
IF NOT SYSOP THEN _
PG = TRUE : _
PASSWORD.SAVE$ = MID$(Z$,2) + _
" " : _
ATTEMPTS.ALLOWED = 0 : _
SUBROUTINE.PARAMETER = 1 : _
CALL PASSWRD
4584 IF PASSWORD.FAILED AND _
(QUICK.SCAN.MESSAGES OR (SCAN.MESSAGES AND NOT PG)) THEN _
GOTO 4635
4585 IF PASSWORD.FAILED THEN _
IF PG THEN _
SJ$ = "<PASSWORD>" _
ELSE SJ$ = "<PROTECTED>" _
ELSE SJ$ = MID$(MESSAGE.RECORD$,76,25)
4590 IF QUICK.SCAN.MESSAGES THEN _
A$ = LEFT$(MESSAGE.RECORD$,5) + _
" " + _
LEFT$(SJ$,19) + _
" " : _
CALL CHKCOLOR (A$,SEARCH.HEADER$,EMPHASIZE.OFF$) : _
GOSUB 12978 : _
SEC.INDEX = SEC.INDEX + 1 : _
IF SEC.INDEX = 3 THEN _
SEC.INDEX = 0 : _
CALL SKIPLINE (1) : _
GOTO 4630 _
ELSE GOTO 4630
4600 IF SCAN.MESSAGES THEN _
GOSUB 8020 : _
GOTO 4630
IF NOT JUST.SEARCHING THEN _
GOSUB 8000
IF RET THEN _
GOTO 4630
IF M(MESSAGE.DIM.INDEX,2) > LAST.MESSAGE.READ THEN _
MAIL.WAITING = FALSE : _
LAST.MESSAGE.READ = M(MESSAGE.DIM.INDEX,2)
CAN.CHG.SEC = (USER.SECURITY.LEVEL => SEC.CHANGE.MSG)
IF EXPERT.USER THEN _
A1$ = ",R,T,=,+,-" + _
MID$(",K",1,- (UH OR SYSOP) * 2) + _
MID$(",S",1, - CAN.CHG.SEC * 2) _
ELSE A1$ = ",R)eply,T)hread,=)reread,+,-" + _
MID$(",K)ill",1, - (UH OR SYSOP) * 7) + _
MID$(",S)ec chg",1, - CAN.CHG.SEC * 12)
TURBO.KEY = -TURBO.KEY.USER
IF JUST.SEARCHING OR NOT JUST.REPLIED THEN _
GOTO 4610
JUST.REPLIED = FALSE
TURBO.KEY = -TURBO.KEY.USER
CALL ASKMORE (A1$,TRUE,FALSE,MESSAGES.SELECTED.INDEX,FALSE)
CALL SKIPLINE (1)
IF NO THEN _
RETURN
CALL ALLCAPS (B$)
REPLY = (REPLY OR B$ = "R")
IF B$ <> "=" THEN _
GOTO 4618
CALL SKIPLINE (1)
4610 IF NOT PASSWORD.FAILED THEN _
GOTO 4613
IF PG THEN _
ATTEMPTS.ALLOWED = 2 : _
SUBROUTINE.PARAMETER = 2 : _
CALL PASSWRD
4611 IF PASSWORD.FAILED THEN _
GOTO 4625
4613 GOSUB 9000
IF JUST.SEARCHING THEN _
GOTO 4625
IF MESSAGES.SELECTED.INDEX > NUMBER.MESSAGES.SELECTED THEN _
GOTO 4650
CALL SKIPLINE (1)
4614 GOSUB 41000
KILL.MESSAGE = FALSE
REPLY = FALSE
IF NON.STOP THEN _
GOTO 4625
4616 TURBO.KEY = -TURBO.KEY.USER
CALL ASKMORE (A1$,TRUE,FALSE,XX,FALSE)
IF NO THEN _
RETURN
CALL ALLCAPS(B$(1))
REPLY = (REPLY OR B$(1) ="R")
IF B$(1) = "=" THEN _
CALL SKIPLINE (1) : _
GOTO 4560
'
' **** CHECK FOR CHANGE SECURITY ****
'
4618 IF B$(1) = "S" AND CAN.CHG.SEC THEN _
GOSUB 4665
IF B$(1) = "T" THEN _
CALL SETTHREAD (CURRENT.MESSAGE, SUBJECT$) : _
IF Q > 0 THEN _
SEARCH.HEADER$ = B$(2) : _
CALL REMOVE (SEARCH.HEADER$,CHR$(34)+CHR$(39)) : _
GOTO 4352
A = INSTR(" +-",B$(1))
IF A > 1 THEN _
CURRENT.MESSAGE = CURRENT.MESSAGE + 5 - 2 * A : _
SEARCH.STRING$ = "" : _
GOTO 4430
'
' **** KILL CURRENT MESSAGE ****
'
IF KILL.MESSAGE AND (UH OR SYSOP) THEN _
IF USER.SECURITY.LEVEL >= OPT.SEC(9) THEN _
CALL PUTMATTR : _
MESSAGE.TO.KILL = CURRENT.MESSAGE : _
TEMP = Q : _
GOSUB 3950 : _
CALL GETMATTR : _
GOTO 4625 _
ELSE VIOLATION$ = "MORE KILL" : _
GOSUB 1380 : _
GOTO 4625
'
' **** REPLY TO CURRENT MESSAGE ****
'
4620 IF NOT REPLY THEN _
GOTO 4625
4621 IF USER.SECURITY.LEVEL < OPT.SEC(5) THEN _
VIOLATION$ = "MORE RE" : _
GOSUB 1380 : _
REPLY = FALSE : _
GOTO 4625
IF LEFT$(SUBJECT$,3) <> "(R)" THEN _
SUBJECT$ = "(R)" + _
LEFT$(SUBJECT$,22)
4622 MESSAGE.TO$ = MESSAGE.FROM$
CALL TRIM (MESSAGE.TO$)
MESSAGE.FROM$ = ACTIVE.USER.NAME$
CALL PUTMATTR
GOSUB 2000
REPLY = FALSE
JUST.REPLIED = TRUE
CALL GETMATTR
GOTO 4560
4625 IF NOT FORWARD AND NOT REVERSE THEN _
GOTO 4370
4630 CALL ASKMORE (",#(s) to read",TRUE,TRUE,XX,FALSE)
IF Q = 0 THEN _
GOTO 4631
IF NO THEN _
RETURN
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10595
IF RET THEN _
RETURN
Z$ = B$(1)
CALL ALLCAPS (Z$)
IF VAL(Z$) > 0 THEN _
FOR I = Q TO 1 STEP -1 : _
B$(I + 1) = B$(I) : _
NEXT : _
B$(1) = "R" : _
Q = Q + 1 : _
RETURN 1235
4631 CALL CARRIER
IF SUBROUTINE.PARAMETER THEN _
RETURN 10595
IF RET THEN _
RETURN
4635 IF SO = 0 THEN _
SO = 1
MESSAGE.DIM.INDEX = MESSAGE.DIM.INDEX + SO
GOTO 4552
4637 IF READ.MESSAGES THEN _
SEARCH.STRING$ = "" : _
SEARCH.HEADER$ = "" : _
TO.REQUESTED = FALSE : _
FROM.REQUESTED = FALSE : _
ADDRESSED.TO.USER = FALSE : _
GOTO 4370
4650 CALL SKIPLINE (1) 'GOSUB 12979
CALL QTPUT ("End Msgs",1)
RETURN
'
' **** - CHANGE MESSAGE READ SECURITY ****
'
4665 IF Q > 1 THEN _
B$ = B$(2) : _
GOTO 4666
A$ = "Change min sec to read from" + _
STR$(MESSAGE.SECURITY) + _
" to"
GOSUB 12995
IF Q=0 THEN _
RETURN
4666 CALL CHECKINT (B$)
IF EC <> 0 THEN _
RETURN
X = TESTED.INTEGER.VALUE
SUBROUTINE.PARAMETER = 3
CALL FILELOCK
GET 1,CURRENT.HEADER
MID$(MESSAGE.RECORD$,121,2) = MKI$(X)
PUT 1,CURRENT.HEADER
SUBROUTINE.PARAMETER = 4
CALL FILELOCK
CALL QTPUT ("Security changed to" + STR$(X),1)
RETURN
'
' **** O - COMMAND FROM MAIN MENU (OPERATOR PAGE) ****
'
4700 IF NOT SYSOP.AVAILABLE THEN _
GOTO 4708
4705 CALL QTPUT ("Chat. Remote Conversation",1)
JJ = VAL(MID$(TIME$,1,2))*100 + VAL(MID$(TIME$,4,2))
IF (JJ > START.OFFICE.HOURS AND JJ < END.OFFICE.HOURS) OR SYSOP.ANNOY THEN _
GOTO 4710
4707 GOTO 4750
4708 A$ = "SYSOP in from" + _
STR$(START.OFFICE.HOURS) + _
" to" + _
STR$(END.OFFICE.HOURS) + ","
GOSUB 12979
GOTO 4755
4710 A$ = "Page " + _
SYSOP.FIRST.NAME$ + _
" ([Y]/N)"
CALL SKIPLINE (1)
GOSUB 12999
IF NO THEN _
RETURN
PAGE.COUNT = 0
A$ = "Paging " + _
SYSOP.FIRST.NAME$ + _
" now"
GOSUB 12978
CALL SETABORT (PAGE.TIME.MAX!,30)
4730 CALL DELAYIT (1)
4735 PAGE.COUNT = PAGE.COUNT + 1
IF INKEY$ = ESCAPE$ THEN _
GOTO 4765
4740 IF PAGE.COUNT MOD 2 THEN _
A$ = PAGING.PRINTER.SUPPORT$ + _
BELL.RINGER$ : _
IF LEN(PAGING.PRINTER.SUPPORT$) = 3 THEN _
CALL PRINTIT (CHR$(7)) : _
IF EC <> 0 THEN _
EL = 4740 : _
GOTO 13000
4745 GOSUB 12978
CALL CHECKTIM (PAGE.TIME.MAX!)
ON SUBROUTINE.PARAMETER GOTO 4730,4747
4747 GOSUB 12979
4750 CALL QTPUT(SYSOP.FIRST.NAME$ + " not responding",1)
4755 CALL QTPUT ("Try a msg or comment",1)
PAGE.STATUS$ = "Paged!"
CALL UPDTCALR ("Operator paged " + LEFT$(TIME$,5),2)
RETURN
4765 CALL UPDTCALR ("Paged & chatted with Sysop",1)
CALL QTPUT ("SYSOP in! " + _
FIRST.NAME$ + _
", this is " + _
SYSOP.FIRST.NAME$ + _
" go ahead!",1)
PAGE.STATUS$ = ""
4770 CM = TRUE
CALL FINDTIME (TIME.CHAT.STARTED!)
SUBROUTINE.PARAMETER = 1
CALL LINE25
A$(2) = ""
4775 CALL LINEEDIT (1,72)
IF SUBROUTINE.PARAMETER < -2 THEN _
GOTO 202
IF KEY.PRESSED$ = ESCAPE$ OR _
SUBROUTINE.PARAMETER = -1 THEN _
GOTO 4777
A$(1) = ""
IF A$(2) <> "" THEN _
A$ = A$(2) : _
A$(1) = A$(2) : _
A$(2) = "" _
ELSE A$ = ""
GOSUB 12978
GOTO 4775
4777 CM = 0
CALL FINDTIME (TI!)
ELAPSED! = FIX(TI! - TIME.CHAT.STARTED!)
IF ELAPSED! < 0 THEN _
ELAPSED! = TI! + (86400! - TIME.CHAT.STARTED!)
SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + ELAPSED!
IF NOT LOCAL.USER THEN _
AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT
CALL QTPUT(" Chat ended. Returning to normal operation",2)
RETURN 1205
'
' **** S - COMMAND FROM UTILITY MENU (STATISTICS) ****
'
4850 IF TURBO.LOGON THEN _
RETURN
CALL QTPUT ("RBBS-PC " + VERSION.ID$ + " Node " + NODE.ID$,1)
A$ = ""
IF NOT CONFERENCE.MODE THEN _
A$ = "Caller # " + _
STR$(CALLS.TODATE!) + _
" "
4855 A$ = A$ + _
"# active msgs:" + _
STR$(ACTIVE.MESSAGES)
A$ = A$ + _
" Next msg #" + _
STR$(HIGH.MESSAGE.NUMBER + 1)
IF LAST.MESSAGE.READ > 0 THEN _
A$ = A$ + _
" Last msg read:" + _
STR$(LAST.MESSAGE.READ)
4857 GOSUB 12976
IF SYSOP THEN _
USER.WORK = (HIGHEST.USER.RECORD * .95) + 1: _
A$ = "USERS: used" + _
STR$(CURRENT.USER.COUNT - 1) + _
" avl" + _
STR$(USER.WORK - CURRENT.USER.COUNT) + _
" MSGS: used" + _
STR$(ACTIVE.MESSAGES) + _
" avl" + _
STR$(MAXIMUM.MESSAGES - ACTIVE.MESSAGES) + _
" MSG REC: used" + _
STR$(NEXT.MESSAGE.RECORD - 1) + _
" avl" + _
STR$(HIGHEST.MESSAGE.RECORD + 1 - NODES.IN.SYSTEM - NEXT.MESSAGE.RECORD) : _
GOSUB 12976 : _
Z$ = UPLOAD.DRIVE.FILE$ : _
CALL FINDFREE : _
CALL QTPUT ("Upload disk has" + FREE.SPACE$,1)
RETURN
4900 IF NOT LOCAL.USER THEN _
CALL UPDTCALR ("Entered " + GRN$,1)
CALL QTPUT("Welcome to " + GRN$,1)
4905 CALL BUFFILE (FILE.NAME$,X)
4910 GOSUB 12986
GOSUB 5344
IF LOF(1) = 0 THEN _
DF$ = ACTIVE.MESSAGE.FILE$ : _
CLOSE 1 : _
KILL ACTIVE.MESSAGE.FILE$ : _
GOSUB 12987 : _
RETURN 13600
GOSUB 23000
RETURN
'
' **** P - COMMAND FROM UTILITY MENU (PASSWORD CHANGE) ****
'
5110 A$ = "Enter new password" + _
PRESS.ENTER$
GOSUB 45010
IF Q = 0 THEN _
RETURN
IF LEN(B$) > 15 OR B$ = SPACE$(LEN(B$)) THEN _
GOTO 5110
CALL ALLCAPS (B$)
Z$ = B$
5120 A$ = "Reenter new password"
GOSUB 45010
IF Q = 0 THEN _
RETURN
CALL ALLCAPS (B$)
IF Z$ <> B$ THEN _
A$ = "Passwords don't match!" : _
GOSUB 12979 : _
RETURN
5125 IF MAXIMUM.PASSWORD.CHANGES AND _
CHANGES.THIS.SESSION > _
MAXIMUM.PASSWORD.CHANGES AND _
NOT SYSOP THEN _
A$ = "No changes permitted" : _
GOSUB 12975 : _
RETURN _
ELSE PASSWORD.CHANGE.ALLOWED = TRUE : _
GOSUB 5140 : _
IF NOT FOUND THEN _
GOTO 5129 _
ELSE A$ = "Temporary change" : _
GOSUB 12975 : _
PASSWORD$ = TEMP.PASSWORD$ : _
SECONDS.PER.SESSION! = TEMP.TIME.ALLOWED * 60 : _
USER.SECURITY.LEVEL = TEMP.SECURITY.LEVEL : _
GOSUB 41070 : _
SYSOP = (USER.SECURITY.LEVEL >= SYSOP.SECURITY.LEVEL) : _
CALL CALLOPT : _
CALL XFERTYPE (2,TRUE)
IF ACTIVE.USER.NAME$ = "SYSOP" THEN _
B$(1) = "********"
5126 CALL UPDTCALR ("Used temp password " + B$,2)
RETURN
5129 GOSUB 12989
CALL OPENUSER (HIGHEST.USER.RECORD)
GOSUB 9450
5130 IF USER.FILE.INDEX < 1 OR _
USER.FILE.INDEX > 32767 THEN _
GOTO 5160
GET 5,USER.FILE.INDEX
CALL ALLCAPS (B$)
LSET PASSWORD$ = B$
GOSUB 9440
GOSUB 12991
A$ = "Password changed"
STOP.INTERRUPTS = TRUE
GOSUB 12975
IF MAXIMUM.PASSWORD.CHANGES THEN _
CHANGES.THIS.SESSION = CHANGES.THIS.SESSION + 1
5131 CALL UPDTCALR ("New Password " + B$(1),2)
RETURN
'
' **** SEARCH "PASSWORDS" FILE FOR TEMPORARY PASSWORDS ****
'
5135 Z$ = ""
Z = 0
GOSUB 5140
IF FOUND THEN _
MINUTES.PER.SESSION! = TEMP.TIME.ALLOWED : _
MAX.PER.DAY = -(MAX.PER.DAY * (TEMP.MAX.PER.DAY <= 0)) - _
(TEMP.MAX.PER.DAY * (TEMP.MAX.PER.DAY > 0)) : _
TIME.LOCK.SET = TEMP.TIME.LOCK : _
IF TEMP.REG.PERIOD > 0 THEN _
DAYS.IN.REGISTRATION.PERIOD = TEMP.REG.PERIOD
IF LIMIT.MINUTES.PER.SESSION! THEN _
IF MINUTES.PER.SESSION! > LIMIT.MINUTES.PER.SESSION! THEN _
MINUTES.PER.SESSION! = LIMIT.MINUTES.PER.SESSION!
SECONDS.PER.SESSION! = MINUTES.PER.SESSION! * 60
RETURN
5140 FOUND = FALSE
CALL OPENWORK (PASSWORDS.FILE$)
IF EC = 53 THEN _
CALL UPDTCALR ("Missing file " + PASSWORDS.FILE$,2) : _
IF Z = 1 THEN _
CALL ALLCAPS (B$(1)) : _
Z$ = B$(1) : _
GOTO 5160 _
ELSE GOTO 5160
Z$ = Z$ + _
SPACE$(15 - LEN(Z$))
5150 IF EOF(2) THEN _
GOTO 5160
5151 CALL GETPASWD
IF EC <> 0 THEN _
EL = 5151 : _
GOTO 13000
IF LEN(TEMP.PASSWORD$) > 15 THEN _
GOTO 5150
TEMP.PASSWORD$ = TEMP.PASSWORD$ + _
SPACE$(15 - LEN(TEMP.PASSWORD$))
IF Z$ <> TEMP.PASSWORD$ THEN _
GOTO 5150
IF PASSWORD.CHANGE.ALLOWED AND _
USER.SECURITY.LEVEL >= MINIMUM.SECURITY.FOR.TEMP.PASSWORD THEN _
GOTO 5155
IF USER.SECURITY.LEVEL <> TEMP.SECURITY.LEVEL THEN _
GOTO 5150
IF START.TIME = 0 THEN _
GOTO 5155
WORK.TIME$ = TIME$
TEST.TIME = VAL(LEFT$(WORK.TIME$,2) + MID$(WORK.TIME$,4,2))
IF TEST.TIME => START.TIME AND TEST.TIME <= END.TIME THEN _
GOTO 5155
IF END.TIME < START.TIME THEN _
IF TEST.TIME => START.TIME OR TEST.TIME <= END.TIME THEN _
GOTO 5155
GOTO 5150
5155 FOUND = TRUE
5160 EC = 0
RETURN
5200 CALL PAGELEN
RETURN
'
' **** J - COMMAND FROM MAIN MENU (JOIN CONFERENCE) ****
'
5300 A1$ = CONFERENCE.MENU$
5301 CALL SUBMENU ("What conference, L)ist, M)ain ([ENTER] quits)",_
A1$,MID$(MAIN.MESSAGE.FILE$,1,2),_
"M.DEF","M",USER.GRAPHIC.DEFAULT$,TRUE,FALSE,FALSE)
IF Q = 0 THEN _
RETURN
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10595
5323 IF Z$ = "M" OR Z$ = "MAIN" THEN _
IF GRN$ = "MAIN" THEN _
RETURN _
ELSE GOTO 5350
ANS.INDEX = 0
IF NOT OK THEN _
GOTO 5300
Q = 0
'
' **** UPDATE PREVIOUS MESSAGE BASE CHECKPOINT RECORD ****
'
5324 PREV.GRN$ = GRN$
GRN$ = Z$
GRN.NAME$ = GRN$
GRN.SAVE$ = GRN$
GOSUB 12986
GOSUB 5342
PREV.MESSAGE$ = ACTIVE.MESSAGE.FILE$
ACTIVE.MESSAGE.FILE$ = FILE.NAME$
GOSUB 5343
'
' **** UPDATE PREVIOUS USER RECORD ****
'
5325 GOSUB 5380
'
' ***** CHECK WHETHER HAVE SUBBORD (I.E. CONFIG.DEF EXISTS) *****
'
5327 USER.RECORD.HOLD$ = USER.RECORD$
CONFERENCE.MODE.SAVE = CONFERENCE.MODE
CONFERENCE.MODE = TRUE
X$ = GRN$ + _
"C.DEF"
PREV.USER$ = ACTIVE.USER.FILE$
PREV.INDEX = USER.FILE.INDEX
PREV.MAIN.USER$ = MAIN.USER.FILE$
PREV.DEF$ = CURRENT.DEF$
CALL FINDIT (X$)
SUB.BOARD = OK
IF NOT SUB.BOARD THEN _
X$ = MID$(MAIN.MESSAGE.FILE$,1,2) + X$ : _
CALL FINDIT (X$) : _
SUB.BOARD = OK
IF SUB.BOARD THEN _
IF LEN(GRN$) = 7 THEN _
IF LEFT$(GRN$,4) = "RBBS" AND RIGHT$(GRN$,2) = "PC" THEN _
SUB.BOARD = FALSE
IF NOT SUB.BOARD THEN _
X$ = MID$(ACTIVE.USER.FILE$,1,2) + _
GRN$ + _
"U.DEF" : _
FILE.NAME$ = WELCOME.FILE.DRV.PATH$ + _
GRN$ + _
"W.DEF" _
ELSE CALL READDEF (X$) : _
IF EC > 0 THEN _
CALL UPDTCALR ("Error"+STR$(EC)+" reading config file "+X$,2) : _
EC = 0 : _
IN.CONF.MENU = FALSE : _
GOTO 5341 _
ELSE X$ = MAIN.USER.FILE$ : _
FILE.NAME$ = ""
UPDATE.DATE = TRUE
CALL FINDIT (X$)
IF OK THEN _
GOTO 5330
'
' ***** NO USER FILE - A PUBLIC CONFERENCE *****
'
MAIN.USER.FILE$ = PREV.MAIN.USER$
IF (USER.SECURITY.LEVEL < AUTO.ADD.SECURITY) THEN _
GOTO 5341
X$ = MAIN.USER.FILE$
SYSOP.PASSWORD.1$ = ""
SYSOP.PASSWORD.2$ = ""
'
' **** CHECK CONFERENCE USER'S FILE ****
'
5330 ACTIVE.USER.FILE$ = X$
IF MAIN.USER.FILE.INDEX < 1 THEN _
FOUND = FALSE : _
USER.FILE.INDEX = 0 : _
GOTO 5340
CALL WORDINFILE (CONFERENCE.MENU$,GRN$,IN.CONF.MENU)
IF ACTIVE.USER.NAME$ = "SYSOP" THEN _
TEMP.HASH.VALUE$ = ORIG.USER.NAME$
GOSUB 12600
GOSUB 12984
5340 IF FOUND THEN _
GOSUB 9500 : _
MAIN.USER.FILE.INDEX = -(SUB.BOARD * USER.FILE.INDEX)_
-((NOT SUB.BOARD) * MAIN.USER.FILE.INDEX) : _
GOTO 5345
'
' **** USER NOT FOUND. AUTO-ADD TO SUBBORAD IF SUFFICIENT SECURITY ****
'
IF SUB.BOARD THEN _
AUTO.ADD.SECURITY = MINIMUM.LOGON.SECURITY
IF (USER.SECURITY.LEVEL >= AUTO.ADD.SECURITY) AND _
(USER.FILE.INDEX > 0) AND (MAIN.USER.FILE.INDEX > 0) THEN _
CALL QTPUT("MEMBER privileges granted in conference " + GRN$,1) : _
LSET USER.RECORD$ = USER.RECORD.HOLD$ : _
MID$(USER.OPTIONS$,3,2) = MKI$(0) : _
MID$(USER.OPTIONS$,1,2) = MKI$(0) : _
ACTIVE.USER.NAME$ = LEFT$(USER.RECORD.HOLD$,30) : _
CALL TRIM (ACTIVE.USER.NAME$) : _
TEMP = -(SUB.BOARD * DEFAULT.SECURITY.LEVEL) _
-((NOT SUB.BOARD) * USER.SECURITY.SAVE) : _
GOSUB 5370 : _
TEMP = -(A * SYSOP.SECURITY.LEVEL) - ((NOT A) * TEMP) : _
LSET SECURITY.LEVEL$ = MKI$(TEMP) : _
USER.SECURITY.LEVEL = TEMP : _
GOSUB 12986 : _
GOSUB 12630 : _
UPDATE.DATE = TRUE : _
FOUND = TRUE : _
GOTO 5340 _
ELSE IF USER.SECURITY.LEVEL >= AUTO.ADD.SECURITY THEN _
CALL QTPUT("GUEST privileges granted in conference " + GRN$,1) : _
ACTIVE.USER.FILE$ = PREV.USER$ : _
UPDATE.DATE = FALSE : _
USER.FILE.INDEX = PREV.INDEX : _
GOSUB 5382 : _
GOTO 5345
5341 IF IN.CONF.MENU THEN _
A$ = "you are not in conference " + _
GRN$ _
ELSE A$ = "no such option " + _
GRN$
'
' **** CANNOT JOIN THE REQUESTED CONFERENCE. THEREFORE, GO BACK ****
'
GOSUB 1397
GRN$ = PREV.GRN$
GRN.NAME$ = GRN$
IF SUB.BOARD THEN _
CALL READDEF (PREV.DEF$)
ACTIVE.MESSAGE.FILE$ = PREV.MESSAGE$
GOSUB 5343
USER.FILE.INDEX = PREV.INDEX
ACTIVE.USER.FILE$ = PREV.USER$
GOSUB 5382
CONFERENCE.MODE = CONFERENCE.MODE.SAVE
GOSUB 12979
GOSUB 12987
ANS.INDEX = 0
GOTO 5301
'
' **** UPDATE POINTERS FOR A MESSAGE BASE **** *
'
5342 GOSUB 12986
GOSUB 5344
GET 1,1
GOSUB 24000
GOSUB 12985
RETURN
'
' **** RESTORE A MESSAGE BASE ****
'
5343 GOSUB 5344
GOSUB 23000
RETURN
'
' ***** OPEN AND SETUP MESSAGE BASE ***** *
'
5344 CALL OPENMSG
IF EC = 64 THEN _
EC = 0 : _
GOTO 5350
FIELD 1, 128 AS MESSAGE.RECORD$
RETURN
'
' ***** SUCCESSFUL CONFERENCE JOIN **** *
'
5345 GRN$ = GRN$ + " " + MID$("ConferenceSubboard",1-10*SUB.BOARD,10)
IF UPDATE.DATE THEN _
BOARD.CHECK.DATE$ = LAST.DATE.TIME.ON$ : _
LSET LAST.DATE.TIME.ON$ = CURRENT.DATE$ + _
" " + _
TIME.LOGGED.ON$ : _
GOSUB 9440 : _
GOSUB 12991
IF GLOBAL.SYSOP THEN _
ACTIVE.USER.NAME$ = "SYSOP"
5347 GOSUB 4900
5348 GOSUB 12987
GOSUB 12990
IF SUB.BOARD THEN _
ACTIVE.FMS.DIRECTORY$ = "" : _
RETURN 108 _
ELSE RETURN 852
'
' **** JOIN M)AIN ****
'
5350 IF GRN$ <> "MAIN" THEN _
CALL QTPUT ("Rejoining " + ORIG.MSG.NAME$,1)
GRN$ = "MAIN"
GRN.NAME$ = ORIG.MSG.NAME$
TURBO.LOGON = TRUE
Q = 0
IN.CONF.MENU = TRUE
IF ACTIVE.USER.NAME$ = "SYSOP" THEN _
ACTIVE.USER.NAME$ = SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$
CONFIG.FILENAME$ = ORIG.CONFIG$
CALL READDEF (CONFIG.FILENAME$)
IF MAIN.MESSAGE.FILE$ <> ACTIVE.MESSAGE.FILE$ THEN _
GOSUB 5342 : _
ACTIVE.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$ : _
GOSUB 5343
IF MAIN.USER.FILE$ <> ACTIVE.USER.FILE$ THEN _
GOSUB 5380 : _
ACTIVE.USER.FILE$ = MAIN.USER.FILE$ : _
GOSUB 12598 : _
GOSUB 12990 : _
IF FOUND THEN _
GOSUB 9500 : _
MAIN.USER.FILE.INDEX = USER.FILE.INDEX : _
CALL CALLOPT : _
CALL XFERTYPE (2,TRUE) _
ELSE USER.FILE.INDEX = 0 : _
MAIN.USER.FILE.INDEX = 0
IF LOCAL.USER.MODE OR NOT LOCAL.USER THEN _
CALL UPDTCALR ("Exited Conference",1)
GOSUB 2350
5360 CONFERENCE.MODE = FALSE
'IF COMMENTS.IN.CONFERENCE = 1 THEN _
' COMMENTS.IN.CONFERENCE = 0 : _
' RETURN
SUB.BOARD = TRUE
GOSUB 12987
RETURN 108
5370 A = (ACTIVE.USER.NAME$ = SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$)
GLOBAL.SYSOP = (GLOBAL.SYSOP OR (A AND ORIG.CONFIG$ = CONFIG.FILENAME$))
RETURN
'
' ***** UPDATE CURRENT USERS RECORD *****
'
5380 IF USER.FILE.INDEX < 1 THEN _
RETURN
IF ADJUSTED.SECURITY AND NOT SYSOP THEN _
LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL) : _
USER.SECURITY.SAVE = USER.SECURITY.LEVEL
GOSUB 12989
CALL DEFAULTU
PUT 5,USER.FILE.INDEX
GOSUB 12991
RETURN
'
' ***** RESTORE A USER RECORD *****
'
5382 IF USER.FILE.INDEX < 1 THEN _
USER.SECURITY.LEVEL = DEFAULT.SECURITY.LEVEL : _
RETURN
CALL OPENUSER (HIGHEST.USER.RECORD)
GET 5,USER.FILE.INDEX
GOSUB 9500
RETURN
'
' ***** R - COMMAND FROM UTILITY MENU (REVIEW PROFILE) *****
'
5400 CALL SKIPLINE(2)
CALL QTPUT ("Your PROFILE (utilities reset)",1)
5410 CALL TOGGLE(-9)
GOSUB 43020
FF = INSTR(DFLTXFER$,USER.TRANSFER.DEFAULT$)
CALL TOGGLE(-5)
GOSUB 42810
CALL TOGGLE(-3)
CALL TOGGLE(-6)
CALL TOGGLE(-7)
CALL TOGGLE(-10)
CALL TOGGLE(-2)
CALL TOGGLE(-4)
CALL TOGGLE(-8)
CALL TOGGLE(-1)
IF RESTRICT.BY.DATE THEN _
IF USER.SECURITY.LEVEL > EXPIRED.SECURITY THEN _
CALL QTPUT ("Registration expires " + EXPIRATION.DATE$,1)
RETURN
'
' ***** B - COMMAND FROM UTILITY MENU (300 TO 450 BAUD CHANGE) *****
'
5500 CALL BAUD450
IF LOCAL.USER OR NOT (SUBROUTINE.PARAMETER OR C = 20) THEN _
RETURN
5502 RETURN 10595 'Entry point when have double nested gosub
'
' ***** V - COMMAND FROM MAIN MENU (VIEW CONFERENCES) *****
'
5800 CALL CONFMAIL
RETURN
'
' * FORMAT MESSAGE HEADER INFORMATION FOR DISPLAY
'
8000 IF RET THEN _
RETURN
8020 IF MID$(MESSAGE.RECORD$,37,5) = "ALL " THEN _
MESSAGE.TO$ = "ALL" : _
GOTO 8040
8030 MESSAGE.TO$ = MID$(MESSAGE.RECORD$,37,22)
CALL TRIM (MESSAGE.TO$)
8040 IF LEN(MESSAGE.TO$) < 23 THEN _
MESSAGE.TO$ = MESSAGE.TO$ + _
SPACE$(23 - LEN(MESSAGE.TO$))
SUBJECT$ = MID$(MESSAGE.RECORD$,76,25)
CALL TRIM (SUBJECT$)
IF PASSWORD.FAILED THEN _
SUBJECT$ = SJ$
8050 MESSAGE.FROM$ = MID$(MESSAGE.RECORD$,6,31)
CALL TRIM (MESSAGE.FROM$)
IF LEN(MESSAGE.FROM$) < 23 THEN _
MESSAGE.FROM$ = MESSAGE.FROM$ + _
SPACE$(23 - LEN(MESSAGE.FROM$))
IF USER.SECURITY.LEVEL >= SEC.CHANGE.MSG THEN _
YY$ = " Security:" + _
STR$(MESSAGE.SECURITY) _
ELSE YY$ = ""
A$ = FG.1$ + "Msg #: " + _
LEFT$(MESSAGE.RECORD$,5) + _
+ YY$
YY$ = FG.4$ + " Sent: " + _
MID$(MESSAGE.RECORD$,68,8) + _
" " + _
MID$(MESSAGE.RECORD$,59,5)
IF NOT RET THEN _
IF READ.MESSAGES THEN _
CALL QTPUT (A$,1): _
X$ = MESSAGE.FROM$ : _
CALL CHKCOLOR (X$,SEARCH.HEADER$,FG.2$) : _
CALL QTPUT (FG.2$ + " From: " + X$ + YY$,1) : _
GOSUB 8076 : _
X$ = MESSAGE.TO$ : _
CALL CHKCOLOR (X$,SEARCH.HEADER$,FG.3$) : _
CALL QTPUT (FG.3$ + " To: " + X$ + " " + FG.2$ + YY$,1) : _
CALL CHKCOLOR (SUBJECT$,SEARCH.HEADER$,FG.4$) : _
A$ = FG.4$ + " Re: " + _
SUBJECT$ + EMPHASIZE.OFF$ _
ELSE A$ = FG.1$ + LEFT$(MESSAGE.RECORD$,5) + _
" " + _
MID$(MESSAGE.RECORD$,68,5) + _
" " + _
+ FG.2$ + LEFT$(MESSAGE.FROM$,18) + _
" -> " + _
+ FG.3$ + LEFT$(MESSAGE.TO$,19) + _
" " + _
+ FG.4$ + LEFT$(SUBJECT$,24) + EMPHASIZE.OFF$ : _
CALL CHKCOLOR (A$,SEARCH.HEADER$,"") : _
GOTO 8080
IF QUICK.SCAN.MESSAGES OR _
SCAN.MESSAGES THEN _ ' TF041203
GOTO 8080 _
ELSE GOTO 8077
8076 IF MID$(MESSAGE.RECORD$,123,6) = STRING$(6,0) OR _
MID$(MESSAGE.RECORD$,123,6) = SPACE$(6) THEN _
YY$ = " Rcvd: -NO-" : _
RETURN
YY$ = " Rcvd: " + _
RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,123,1))),2) + _
"-" + _
RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,124,1))),2) + _
"-" + _
RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,125,1))),2) + _
" " + _
RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,126,1))),2) + _
":" + _
RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,127,1))),2)
FOR I = 8 TO 15
IF MID$(YY$,I,1) = " " THEN _
MID$(YY$,I,1) = "0"
NEXT
FOR I = 17 TO 21
IF MID$(YY$,I,1) = " " THEN _
MID$(YY$,I,1) = "0"
NEXT
RETURN
8077 IF MSG.FROM.CALLER OR (NOT MSG.TO.CALLER) THEN _
GOTO 8080
YY$ = DATE$
WK$ = TIME$
MID$(MESSAGE.RECORD$,123,6) = CHR$(VAL(MID$(YY$,1,2))) + _
CHR$(VAL(MID$(YY$,4,2))) + _
CHR$(VAL(MID$(YY$,9,2))) + _
CHR$(VAL(MID$(WK$,1,2))) + _
CHR$(VAL(MID$(WK$,4,2))) + _
CHR$(VAL(MID$(WK$,7,2)))
GOSUB 12986
PUT 1,M(MESSAGE.DIM.INDEX,1)
GOSUB 12987
8080 GOSUB 12979
A$ = ""
RETURN
'
' * UNCOMPRESS MESSAGE PRIOR TO DISPLAY *
'
9000 IF NOT JUST.SEARCHING THEN _
CALL SKIPLINE (1)
FOR X = 2 TO VAL(MID$(MESSAGE.RECORD$,117,4))
IF NOT JUST.SEARCHING THEN _
GOSUB 12978 : _
EOL = FALSE : _
J = 1
GET 1
IF JUST.SEARCHING THEN _
A$ = MESSAGE.RECORD$ : _
CALL ALLCAPS (A$) : _
HIGHLITE.POS = INSTR(A$,SEARCH.STRING$) : _
IF HIGHLITE.POS > 0 THEN _
HIGHLITE.REC = LOC(1) : _
X = 9999 : _
GOTO 9090 _
ELSE GOTO 9090
9050 B = INSTR(J,MESSAGE.RECORD$,CHR$(227))
IF RET THEN _
RETURN
9060 C = B - J
IF C < 0 THEN _
C = 128 : _
EOL = TRUE
9070 A$ = MID$(MESSAGE.RECORD$,J,C)
IF HIGHLITE.REC = LOC(1) THEN _
IF HIGHLITE.POS >= J AND HIGHLITE.POS < J+C THEN _
HIGHLITE.REC = -1 : _
CALL BRACKET (A$,HIGHLITE.POS-J+1,HIGHLITE.POS+LEN(SEARCH.STRING$)-J,EMPHASIZE.ON$,EMPHASIZE.OFF$)
' CALL COLORIZE (A$,HIGHLITE.POS+LEN(SEARCH.STRING$)-J,HIGHLITE.POS-J+1,EMPHASIZE.ON$,EMPHASIZE.OFF$)
IF EOL THEN _
GOTO 9090
9085 J = B + 1
CALL QTPUT (A$,1)
CALL ASKMORE ("",TRUE,TRUE,MESSAGES.SELECTED.INDEX,FALSE)
IF NO THEN _
GOTO 5160
GOTO 9050
9090 NEXT
IF JUST.SEARCHING AND HIGHLITE.POS > 0 THEN _
JUST.SEARCHING = FALSE : _
GET 1,M(MESSAGE.DIM.INDEX,1) : _
GOSUB 8000 : _
GOTO 9000
A$ = ""
RETURN
'
' * C - COMMAND FROM UTILITY MENU (CLOCK - TIME ON SYSTEM) *
'
9100 CALL RPTTIME
RETURN
'
' * WRITE A RECORD TO THE RBBS-PC "USER" FILE *
'
9440 IF USER.FILE.INDEX > 0 AND USER.FILE.INDEX < 32768 THEN _
PUT 5,USER.FILE.INDEX
RETURN
'
' * DEFINE USER FILE RECORD VARIABLES TO COMPENSATE FOR THE BUG IN QUICKBASIC *
' * THAT REQUIRES A FIELD STATMENT TO BE EXECUTED WITHIN EACH SEPARATELY *
' * COMPILED PROGRAM -- EVEN THOUGH A FIELD STATEMENT WAS EXECUTED WHEN THE *
' * FILE WAS OPENED IN ANOTHER SEPERATELY COMPILED SUBROUTINE *
'
9450 IF LOF(5) < 1 THEN _
DF$ = ACTIVE.USER.FILE$ : _
RETURN 13600
FIELD 5,31 AS USER.NAME$, _
15 AS PASSWORD$, _
2 AS SECURITY.LEVEL$, _
14 AS USER.OPTIONS$, _
24 AS CITY.STATE$, _
3 AS MACHINE.TYPE$, _
4 AS TODAY.DL$, _
4 AS TODAY.BYTES$, _
4 AS DL.BYTES$, _
4 AS UL.BYTES$, _
14 AS LAST.DATE.TIME.ON$, _
3 AS LIST.NEW.DATE$, _
2 AS USER.DOWNLOADS$, _
2 AS USER.UPLOADS$, _
2 AS ELAPSED.TIME$
FIELD 5,128 AS USER.RECORD$
RETURN
'
' * GET USER DEFAULTS *
'
9500 GOSUB 9450
GOSUB 5370
IF A THEN _
USER.SECURITY.LEVEL = SYSOP.SECURITY.LEVEL _
ELSE USER.SECURITY.LEVEL = CVI(SECURITY.LEVEL$)
LAST.MESSAGE.READ = CVI(MID$(USER.OPTIONS$,3,2))
USER.TRANSFER.DEFAULT$ = MID$(USER.OPTIONS$,5,1)
IF USER.TRANSFER.DEFAULT$ = " " THEN _
USER.TRANSFER.DEFAULT$ = "N"
CALL XFERTYPE (2,TRUE)
X = ASC(MID$(USER.OPTIONS$,6,1))
GR = (X MOD 3)
BOLD.TEXT$ = CHR$(48 - (X > 50))
USER.TEXT.COLOR = (X - GR)/3 + 21
IF USER.TEXT.COLOR > 37 THEN _
USER.TEXT.COLOR = USER.TEXT.COLOR - 7
IF EMPHASIZE.OFF$ <> "" THEN _
CALL QTPUT (COLOR.RESET$,0)
IF EMPHASIZE.ON.DEF$ <> "" THEN _
EMPHASIZE.OFF$ = ESCAPE$ + "[" + BOLD.TEXT$ + ";40;" + MID$(STR$(USER.TEXT.COLOR),2) + "m" _
ELSE EMPHASIZE.OFF$ = ""
IF GR = 1 AND NOT EIGHT.BIT THEN _
GR = 0
CALL SETUGD (GR, USER.GRAPHIC.DEFAULT$)
RIGHT.MARGIN = CVI(MID$(USER.OPTIONS$,7,2))
IF RIGHT.MARGIN > 72 THEN _
RIGHT.MARGIN = 72
9510 USER.OPTIONS = CVI(MID$(USER.OPTIONS$,9,2))
PROMPT.BELL = (USER.OPTIONS AND 1) > 0
EXPERT.USER = (USER.OPTIONS AND 2) > 0
CALL SETEXPERT
NULLS = (USER.OPTIONS AND 4) > 0
UPPER.CASE = (USER.OPTIONS AND 8) > 0
LINE.FEEDS = (USER.OPTIONS AND 16) > 0
CHECK.BULLETIN.LOGON = (USER.OPTIONS AND 32) > 0
SKIP.FILES.LOGON = (USER.OPTIONS AND 64) > 0
AUTODOWNLOAD.DESIRED = (USER.OPTIONS AND 128) > 0
REQ.QUES.ANSWERED = (USER.OPTIONS AND 256) > 0
MAIL.WAITING = (USER.OPTIONS AND 512) > 0
X = (USER.OPTIONS AND 1024 ) > 0
CALL SETHILITE (NOT X)
IF NOT HIGHLIGHT.OFF THEN _
CALL QTPUT (EMPHASIZE.OFF$,0)
TURBO.KEY.USER = (USER.OPTIONS AND 2048) > 0
TURBO.KEY = FALSE
GOSUB 11480
PAGE.LENGTH = ASC(MID$(USER.OPTIONS$,13,1))
X$ = ECHOER$
ECHOER$ = MID$(USER.OPTIONS$,14,1)
IF INSTR("ICR",ECHOER$) = 0 THEN _
ECHOER$ = "R"
IF X$ <> ECHOER$ THEN _
GOSUB 9525
CALL SETECHO (ECHOER$)
9520 NUL$ = MID$(STRING$(5,0),1, - 5 * NULLS)
CALL SETCRLF
USE.TPUT = (UPPER.CASE OR XON.XOFF)
PASSWORD.SAVE$ = PASSWORD$
RETURN
9525 IF ECHOER$ = "R" THEN _
CALL QTPUT ("RBBS now echoing what you type",1) _
ELSE IF ECHOER$ = "C" THEN _
CALL QTPUT ("Please set your communications package to echo",1) _
ELSE CALL QTPUT ("Intermediate host now echoing what you type",1)
RETURN
'
' * B - COMMAND FROM MAIN MENU (READ BULLETINS) *
'
9700 RETURN.ON$ = "N"
A1$ = BULLETIN.MENU$
9701 CALL SUBMENU ("Read what bulletin(s), L)ist, N)ew ([ENTER] = none)",_
A1$, BULLETIN.PREFIX$,"",RETURN.ON$,_
USER.GRAPHIC.DEFAULT$,FALSE,FALSE,FALSE)
IF Q = 0 THEN _
RETURN
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10595
IF Z$ = "N" THEN _
GOTO 9760
STOP.INTERRUPTS = FALSE
CALL BUFFILE (FILE.NAME$,ANS.INDEX)
CALL UPDTCALR ("Read bulletin " + FILE.NAME$,1)
9703 ANS.INDEX = ANS.INDEX + 1
IF ANS.INDEX > LAST.INDEX THEN _
ANS.INDEX = 0
GOTO 9701
'
' * CHECK AND REVIEW NEW BULLETINS SINCE LAST LOGON *
'
9750 CALL CHKNEWBUL (BOARD.CHECK.DATE$,NUM.NEW.BULLETS,NEW.BULLETS$)
CALL SKIPLINE (1)
A$ = STR$(NUM.NEW.BULLETS) + _
" NEW BULLETIN(S) since last call" + _
NEW.BULLETS$
GOSUB 12979
RETURN
9760 ' **** [entry when want review plus chance to read] *********
GOSUB 9750
IF NUM.NEW.BULLETS > 0 THEN _
LAST.INDEX = Q : _
A$ = "READ ALL new bulletins ([Y],N)" : _
GOSUB 12999 : _
IF NOT NO THEN _
ANS.INDEX = 2: _
GOTO 9700
IF ANS.INDEX < 1 THEN _
RETURN _
ELSE ANS.INDEX = 0 : _
GOTO 9701
'
' * W - COMMAND FROM MAIN MENU (WHO'S ON THE OTHER NODES) *
'
9800 CALL WHOSON (NODES.IN.SYSTEM)
GOSUB 5344
RETURN
'
' * 1 - COMMAND FROM SYSOP MENU (DISPLAY COMMENTS) *
'
10070 CALL MUZAK (7)
FILE.NAME$ = COMMENTS.FILE$
IF NOT STOP.INTERRUPTS THEN _
A$ = "* Ctrl-K(^K) / ^X aborts. ^S suspends, ^Q resumes *" : _
GOSUB 12976
GOSUB 20150
RETURN
'
' * U - COMMAND FROM UTILITY MENU (DISPLAY USERS) *
' * 2 - COMMAND FROM SYSOP MENU (DISPLAY USERS) *
'
10090 CALL MUZAK (6)
A$ = "List - U)sers, R)ecent callers"
CALL SKIPLINE (1)
GOSUB 12998
IF Q = 0 THEN _
RETURN
CALL ALLCAPS (B$(1))
ON INSTR("UR",B$(1)) + 1 GOTO 10090,10096,10093
10093 CALL DISPCALL
FIELD 4, 64 AS CALLERS.RECORD$
RETURN
10096 USER.RECORD.HOLD$ = USER.RECORD$
GOSUB 12700
CALL OPENUSER (HIGHEST.USER.RECORD)
GOSUB 9450
STOP.INTERRUPTS = FALSE
NON.STOP = (PAGE.LENGTH < 1)
I = 1
Z$ = SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$
10097 IF I > HIGHEST.USER.RECORD OR RET THEN _
GOTO 10099
GET 5,I
X$ = MID$(USER.RECORD$,START.HASH,LEN.HASH)
IF ASC(X$)=0 OR LEFT$(X$,3)=" " OR LEFT$(PASSWORD$,3)=" " THEN _
GOTO 10098
IF INSTR(X$,Z$) > 0 OR SYSOP.SECURITY.LEVEL <= CVI(MID$(USER.RECORD$,47,2)) THEN _
IF NOT SYSOP THEN _
GOTO 10098
CALL ASKMORE ("",TRUE,TRUE,XX,FALSE)
IF NO OR SUBROUTINE.PARAMETER = -1 THEN _
GOTO 10099
CALL QTPUT (LEFT$(X$,36) + CITY.STATE$ + LAST.DATE.TIME.ON$,1)
10098 I = I + 1
GOTO 10097
10099 A$ = ""
LSET USER.RECORD$ = USER.RECORD.HOLD$
STOP.INTERRUPTS = TRUE
RETURN
'
' * 3 - COMMAND FROM SYSOP MENU (RECOVER MESSAGES) *
'
10390 A$ = "Recover Msg #"
GOSUB 12995
CALL CHECKINT (B$(1))
IF EC <> 0 THEN _
GOTO 10390
MESSAGE.TO.RECOVER = TESTED.INTEGER.VALUE
IF MESSAGE.TO.RECOVER < 1 THEN _
GOTO 12980
GOSUB 5344
ACTION.FLAG = FALSE
CALL RECOVMSG (MESSAGE.TO.RECOVER,FIRST.MESSAGE.RECORD,ACTION.FLAG)
10392 IF ACTION.FLAG THEN _
GOTO 1900
RETURN
'
' * 4 - COMMAND FROM SYSOP MENU (DELETE COMMENTS) *
'
10530 A$ = "Delete comments (Y/[N])"
GOSUB 12995
IF YES THEN _
CALL OPENOUTW (COMMENTS.FILE$)
CLOSE 2
10550 RETURN
'
' * TIME LIMIT EXCEEDED EXIT *
'
10553 CALL UPDTCALR ("Time limit exceeded",1)
'
' * Q - COMMAND FROM GLOBAL FUNCTIONS *
'
10560 CHAT.AVAILABLE = FALSE
GOSUB 9100
IF NOT SYSOP AND _
USER.SECURITY.LEVEL < SECURITY.EXEMPT.FROM.EPILOG THEN _
FILE.NAME$ = EPILOG$ : _
GOSUB 11520
IF LOCAL.USER.MODE OR NOT LOCAL.USER THEN _
CALL UPDTCALR ("Logged off",1)
CALL MUZAK (4)
GOTO 10595
10570 IF TIME.REMAINING! > 1 AND (TURBO.KEY.USER OR NOT EXPERT.USER) THEN _
A$ = "End session (Y,[N])" : _
GOSUB 12999 : _
IF NOT YES THEN _
RETURN
GOTO 10560
10590 CALL UPDTCALR ("Sleep Disconnect",1)
10595 CALL GETIME
GOSUB 13700
CALL UPDATEU
GOTO 13540
10620 CALL UPDTCALR(LG$(LOGON.ERROR.INDEX),2)
10621 IF ACTIVE.USER.NAME$ = "" THEN _
ACTIVE.USER.NAME$ = "NAME UNAVAILABLE"
Z$ = ACTIVE.USER.NAME$ + _
" on at " + _
CURRENT.DATE$ + _
", " + _
TIM$ + _
"** LOGON DENIED **, " + _
BAUD.PARITY$
NG$ = Z$ + _
SPACE$(128 - LEN(Z$))
10698 CALL MUZAK (5)
A$ = "Access denied!"
GOSUB 12976
CALL DELAYIT (8 + BPS)
GOTO 13545
'
' * M - COMMAND FROM UTILITY MENU (CHANGE MARGINS) *
'
10925 UTILITY.MARGIN.CHANGE = TRUE
GOSUB 3100
UTILITY.MARGIN.CHANGE = FALSE
RETURN
'
' * 7 - COMMAND FROM SYSOP MENU (EXIT TO DOS) *
'
10930 IF DOS.VERSION < 2 OR _
(REQUIRED.RINGS = 0 AND NOT SHOOT.YOURSELF) THEN _
CALL QTPUT("Remote DOS unavailable",1) : _
RETURN
10932 IF LOCAL.USER AND NOT DEBUG THEN _
CALL QTPUT("Only for remote SYSOP's",1) : _
RETURN
CALL DOSEXIT
SUBROUTINE.PARAMETER = -9
CALL FINDFUNC
GOTO 202
'
' * D - COMMAND FROM MAIN MENU (EXIT TO DOORS) *
'
10970 IF NOT DOORS.AVAILABLE OR _
(REQUIRED.RINGS = 0 AND NOT SHOOT.YOURSELF) THEN _
CALL QTPUT("All doors locked!",1) : _
RETURN
IF TIME.LOCK AND 1 THEN _
CALL TIMELOCK : _
IF NOT OK THEN _
RETURN
10974 A1$ = MENU$(5)
CALL SUBMENU ("Open which door, L)ist" + PRESS.ENTER.EXPERT$, _
A1$,"",".BAT","",_
USER.GRAPHIC.DEFAULT$,TRUE,FALSE,TRUE)
IF Q = 0 THEN _
RETURN
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10595
10986 Z$ = FILE.NAME$
CALL DOOREXIT
'
' * 5 - COMMAND FROM SYSOP MENU (USER FILE MAINTENANCE) *
'
11000 TU = USER.FILE.INDEX
USER.RECORD.HOLD$ = USER.RECORD$
REG.DATE.HOLD$ = REG.DATE$
STOP.INTERRUPTS = TRUE
I = 1
SCAN.USERS = FALSE
TURBO.KEY = -TURBO.KEY.USER
A$ = "A)dd, L)st, P)rt, M)od, S)can users"
GOSUB 12998
11003 IF Q = 0 THEN _
GOTO 20093
QQ = 0
Z$ = LEFT$(B$(1),1)
CALL ALLCAPS (Z$)
IF Z$ = "A" THEN _
GOTO 12300 _
ELSE IF Z$ = "M" THEN _
STOP.INTERRUPTS = TRUE _
ELSE IF Z$ = "P" THEN _
QQ = TRUE _
ELSE IF Z$ = "S" THEN _
SCAN.USERS = TRUE : _
STOP.INTERRUPTS = TRUE _
ELSE IF Z$ <> "L" THEN _
GOTO 11000
11005 CALL OPENUSER (HIGHEST.USER.RECORD)
GOSUB 9450
Z = 1
IF SCAN.USERS THEN _
A$ = "Scan for N)ame, P)wd, C)ity/St, or L)evel" : _
GOSUB 12999 : _
A$ = "" : _
SCAN.FUNCTION$ = LEFT$(B$(1),1) : _
CALL ALLCAPS (SCAN.FUNCTION$) : _
CR = 0 : _
GOSUB 12979 : _
GOSUB 12966 : _
GOTO 12962
11010 FOR J = Z TO HIGHEST.USER.RECORD
GET 5,J
11015 X$ = MID$(USER.RECORD$,START.HASH,LEN.HASH)
IF ASC(X$) = 0 OR LEFT$(X$,3) = " " THEN _
GOTO 11310
OF = CVI(SECURITY.LEVEL$)
A$ = FG.4$ + RIGHT$(" " + STR$(LOC(5)),4) + _
":" + _
FG.1$ + USER.NAME$ + _
FG.2$ + "SECURITY" + _
RIGHT$(" " + STR$(OF),5) + _
" "
11020 A$ = A$ + _
FG.3$ + "Password = " + _
PASSWORD$ + EMPHASIZE.OFF$
11025 IF QQ THEN _
CALL PRINTIT (A$)
11027 GOSUB 12979
IF RET <> 0 THEN _
GOTO 11330
IF OF < MINIMUM.LOGON.SECURITY THEN _
A$ = EMPHASIZE.ON$ + "<Locked out>" + EMPHASIZE.OFF$ + SPACE$(7) : _
GOTO 11030
IF OF >= SYSOP.SECURITY.LEVEL THEN _
A$ = EMPHASIZE.ON$ + " (SYSOP) " + EMPHASIZE.OFF$ + SPACE$(8) : _
GOTO 11030
A$ = SPACE$(19)
11030 A$ = A$ + _
LAST.DATE.TIME.ON$ + _
" " + _
FG.4$ + CITY.STATE$ + EMPHASIZE.OFF$
11100 IF QQ THEN _
CALL PRINTIT (A$)
11101 CALL QTPUT(A$,1)
IF RET <> 0 THEN _
GOTO 11330
A$ = " DOWNLOADS = " + _
RIGHT$(" " + STR$(CVI(USER.DOWNLOADS$)),5) + _
" " + _
"UPLOADS = " + _
RIGHT$(" " + STR$(CVI(USER.UPLOADS$)),5) + _
" " + _
" Times on ="
A$ = A$ + RIGHT$(" " + STR$(CVI(MID$(USER.OPTIONS$,1,2))),5) + _
" " + _
"TIME USED = " + _
RIGHT$(" " + STR$(CVI(ELAPSED.TIME$)),4) + _
" Min"
IF QQ THEN _
CALL PRINTIT (A$)
11105 CALL QTPUT (A$,1)
IF RET <> 0 THEN _
GOTO 11330
IF NOT ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _
GOTO 11106
A$ = "BYTES: Dwn=" + STR$(CVS(DL.BYTES$)) + _
" Up=" + STR$(CVS(UL.BYTES$)) + _
" TODAY Dwn: #=" + STR$(CVS(TODAY.DL$)) + _
" Bytes=" + STR$(CVS(TODAY.BYTES$))
IF QQ THEN _
CALL PRINTIT (A$)
CALL QTPUT (A$,1)
IF RET <> 0 THEN _
GOTO 11330
11106 IF NOT RESTRICT.BY.DATE THEN _
GOTO 11107
GOSUB 11480
A$ = "Registration date = " + _
REG.DISPLAY.DATE$
IF QQ THEN _
CALL PRINTIT (A$)
CALL QTPUT (A$,1)
IF RET <> 0 THEN _
GOTO 11330
11107 IF NOT STOP.INTERRUPTS THEN _
GOTO 11310
11110 A$ = "D)el,F)ind,M)enu,N)ew pwd,P)rnt,R)eset grph,Q)uit,S)ecLvl,U)ser#"
IF RESTRICT.BY.DATE THEN _
A$ = A$ + _
",$)RegDate"
GOSUB 12999
IF NOT SCAN.USERS AND Q = 0 THEN _
GOTO 11310
11115 Z$ = LEFT$(B$(1),1)
CALL ALLCAPS (Z$)
X = INSTR("DNPQFSMR$U",Z$)
IF Z$ = "" AND SCAN.USERS THEN _
GOTO 12965
ON X GOTO 11130,11160,11220,11320,11340,11390,11330,11400,11450,11127
11125 Z = VAL(B$)
IF Z < 1 OR Z > HIGHEST.USER.RECORD - 1 THEN _
GOTO 11310
GOTO 11010
11127 A$ = "What record #"
GOSUB 12995
GOTO 11125
'
' * D - COMMAND FROM 5- USER MAINTENANCE OPTIONS (DELETE USER) *
'
11130 A$ = "Delete user (Y/[N])"
GOSUB 12995
IF YES THEN _
LSET USER.NAME$ = CHR$(0) + _
"deleted user" : _
LSET SECURITY.LEVEL$ = MKI$(MINIMUM.LOGON.SECURITY - 1) : _
LSET LAST.DATE.TIME.ON$ = "01-01-80" + _
" " + _
TIME.LOGGED.ON$
GOTO 11290
'
' * N - COMMAND FROM 5- USER MAINTENANCE OPTIONS (CHANGE USER PASSWORD) *
'
11160 GOSUB 12800
GOTO 11290
'
' * P - COMMAND FROM 5- USER MAINTENANCE OPTIONS (PRINT USER FILE) *
'
11220 QQ = NOT QQ
GOTO 11015
11290 USER.FILE.INDEX = LOC(5)
GOSUB 12989
GOSUB 9440
GOSUB 12991
USER.FILE.INDEX = 0
GOTO 11015
11310 IF SCAN.USERS THEN _
GOTO 12965
11311 NEXT
'
' * Q - COMMAND FROM 5- USER MAINTENANCE OPTIONS (QUIT TO MAIN MENU) *
'
11320 USER.FILE.INDEX = TU
LSET USER.RECORD$ = USER.RECORD.HOLD$
REG.DATE$ = REG.DATE.HOLD$
RETURN 1200
'
' * M - COMMAND FROM 5- USER MAINTENANCE OPTIONS (MAIN USER MAINT. MENU) *
'
11330 CLOSE 2
GOTO 11000
'
' * F - COMMAND FROM 5- USER MAINTENANCE OPTIONS (FIND USER) *
'
11340 A$ = PROMPT.HASH$ + _
" to find"
CALL SKIPLINE (1)
GOSUB 12995
IF Q = 0 THEN _
GOTO 11340
TEMP.HASH.VALUE$ = B$
IF LEN(TEMP.HASH.VALUE$) < 3 OR LEN(TEMP.HASH.VALUE$) > LEN.HASH THEN _
GOTO 11340
CALL ALLCAPS (TEMP.HASH.VALUE$)
IF START.INDIV < 1 THEN _
GOTO 11345
11342 A$ = PROMPT.INDIV$ + _
" to find"
GOSUB 12995
IF Q = 0 THEN _
GOTO 11342
TEMP.INDIV.VALUE$ = B$
IF LEN(TEMP.INDIV.VALUE$) < 3 OR LEN(TEMP.INDIV.VALUE$) > LEN.INDIV THEN _
GOTO 11342
CALL ALLCAPS (TEMP.INDIV.VALUE$)
11345 GOSUB 12600
GOSUB 12984
USER.FILE.INDEX = 0
IF FOUND THEN _
GOTO 11015
11380 A$ = TEMP.HASH.VALUE$ + _
" " + _
TEMP.INDIV.VALUE$ + _
" not found"
GOSUB 12977
GOTO 11310
'
' * S - COMMAND FROM 5- USER MAINTENANCE OPTIONS (CHANGE USER SECURITY) *
'
11390 GOSUB 11395
LSET SECURITY.LEVEL$ = MKI$(OF)
GOTO 11290
11395 A$ = "New sec level"
GOSUB 12995
CALL ALLCAPS (B$(1))
Z$ = B$(1)
OF = VAL(Z$)
IF OF > USER.SECURITY.LEVEL THEN _
OF = USER.SECURITY.LEVEL
RETURN
'
' * R - COMMAND FROM 5- USER MAINTENANCE OPTIONS (RESET USER GRAPHICS) *
'
11400 LSET USER.OPTIONS$ = LEFT$(USER.OPTIONS$,5) + _
"0" + _
MID$(USER.OPTIONS$,7)
GOTO 11290
'
' * $ - COMMAND FROM 5 - USER MAINTENANCE (CHANGE REGISTRATION DATE) *
'
11450 A$ = "Enter new registration date (MM-DD-YY)"
GOSUB 12995
IF Q = 0 THEN _
GOTO 11015
11455 WORK.DATE$ = B$(1)
IF LEN(WORK.DATE$) < 8 THEN _
GOTO 11450
GOSUB 11470
IF NOT OK THEN _
GOTO 11450
LSET USER.OPTIONS$ = LEFT$(USER.OPTIONS$,10) + _
REG.DATE$ + _
MID$(USER.OPTIONS$,13)
GOSUB 11480
REG.DATE$ = REG.DATE.HOLD$
GOTO 11290
'
' * CALCULATE REGISTRATION DATES *
'
11470 IF LEN(WORK.DATE$) < 10 THEN _
WORK.DATE$ = LEFT$(WORK.DATE$,6) + _
"19" + _
RIGHT$(WORK.DATE$,2)
TODAY.REG.YY = VAL(MID$(WORK.DATE$,7))
TODAY.REG.MM = VAL(LEFT$(WORK.DATE$,2))
TODAY.REG.DD = VAL(MID$(WORK.DATE$,4,2))
OK = TODAY.REG.YY > 1979 AND TODAY.REG.MM > 0 AND _
TODAY.REG.MM < 13 AND TODAY.REG.DD > 0 AND _
TODAY.REG.DD < 32
IF OK THEN _
CALL TWOBYTEDATE (TODAY.REG.YY,TODAY.REG.MM,TODAY.REG.DD,REG.DATE$)
RETURN
11480 X$ = MID$(USER.OPTIONS$,11,2)
IF CVI(X$) <> 0 THEN _
REG.DATE$ = X$ : _
ELSE GOSUB 11482
CALL UNCDATE (REG.DATE$,USER.REG.YY,USER.REG.MM,USER.REG.DD,REG.DISPLAY.DATE$)
IF CVI(X$) = 0 THEN _
REG.DISPLAY.DATE$ = "00-00-00"
RETURN
11482 WORK.DATE$ = DATE$
GOTO 11470
'
' * ALLOW USERS TO ANSWER A "QUESTIONNAIRE" BASED ON THE RBBS-PC SCRIPT *
'
11520 QUESTIONNAIRE.ABORTED = FALSE
QUESTIONNAIRE.CHAIN.STARTED = FALSE
CALL FINDIT (FILE.NAME$)
IF NOT OK THEN _
RETURN
REDIM A$(256)
CALL ASKUSERS
IF ADJUSTED.SECURITY THEN _
GOSUB 12989 : _
LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL) : _
GOSUB 9440 : _
GOSUB 12991 : _
CALL CALLOPT : _
CALL XFERTYPE (2,TRUE) : _
GOSUB 5135
REDIM A$(ADIM)
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10595
OK = TRUE
RETURN
'
' * A - COMMAND FROM 5- USER MAINTENANCE OPTIONS (ADD USER) *
'
12300 A1$ = ""
ATTEMPTS = 0
USER.SECURITY.LEVEL.SAVE = USER.SECURITY.LEVEL
FIRST.NAME.SAVE$ = FIRST.NAME$
LAST.NAME.SAVE$ = LAST.NAME$
ACTIVE.USER.NAME.SAVE$ = ACTIVE.USER.NAME$
CITY.STATE.SAVE$ = CI$
HASH.VALUE.SAVE$ = HASH.VALUE$
INDIV.VALUE.SAVE$ = INDIV.VALUE$
GOSUB 12500
GOSUB 12840
GOSUB 12850
GOSUB 12598
IF USER.FILE.INDEX = 0 THEN _
GOSUB 12984 : _
GOTO 12330
IF FOUND THEN _
D$ = "User already exists" : _
GOSUB 1315 : _
GOSUB 12984 : _
GOTO 12330
12310 GOSUB 12630
GOSUB 12800
GOSUB 11395
TEMP.SECURITY.LEVEL = OF
GOSUB 12900
LSET LAST.DATE.TIME.ON$ = CURRENT.DATE$ + _
" " + _
TIME.LOGGED.ON$
GOSUB 12960
CALL ALLCAPS (B$)
LSET CITY.STATE$ = B$
LSET ELAPSED.TIME$ = MKI$(0)
IF START.HASH > 1 THEN _
MID$(USER.RECORD$,START.HASH,LEN.HASH) = HASH.VALUE$
IF START.INDIV > 1 THEN _
MID$(USER.RECORD$,START.INDIV,LEN.INDIV) = INDIV.VALUE$
GOSUB 9440
12320 GOSUB 12991
12330 USER.SECURITY.LEVEL = USER.SECURITY.LEVEL.SAVE
FIRST.NAME$ = FIRST.NAME.SAVE$
LAST.NAME$ = LAST.NAME.SAVE$
ACTIVE.USER.NAME$ = ACTIVE.USER.NAME.SAVE$
CI$ = CITY.STATE.SAVE$
HASH.VALUE$ = HASH.VALUE.SAVE$
INDIV.VALUE$ = INDIV.VALUE.SAVE$
USER.FILE.INDEX = TU
LSET USER.RECORD$ = USER.RECORD.HOLD$
GOTO 11000
'
' * GET USER FIRST AND LAST NAMES *
'
12500 IF ATTEMPTS > 5 THEN _
FF = TRUE : _
RETURN
12510 GOSUB 12700
ATTEMPTS = ATTEMPTS + 1
A$ = A1$ + _
FIRST.NAME.PROMPT$
CALL SKIPLINE (1)
LOGON.ACTIVE = TRUE
GOSUB 12555
LOGON.ACTIVE = FALSE
CALL TRIM (Z$)
FIRST.NAME$ = Z$
IF Q <> 1 THEN _
I = 2: _
GOSUB 12556 : _
GOTO 12540
12530 A$ = A1$ + _
LAST.NAME.PROMPT$
GOSUB 12555
IF Q > 0 AND INSTR(B$,";") = 0 THEN _
Z$ = B$ _
ELSE Z$ = B$(1)
CALL ALLCAPS (Z$)
12540 CALL TRIM (Z$)
LAST.NAME$ = Z$
IF LEN(LAST.NAME$) < 2 THEN _
IF LEN(FIRST.NAME$) > 2 THEN _
GOTO 12500
IF (LEN(FIRST.NAME$) + LEN(LAST.NAME$)) > 30 THEN _
GOTO 12500
IF USER.SECURITY.LEVEL.SAVE < SYSOP.SECURITY.LEVEL THEN _
IF (LEN(FIRST.NAME$) < 2 OR LEN(LAST.NAME$) < 2) THEN _
GOTO 12500 _
ELSE IF LEFT$(FIRST.NAME$,1)=" " OR LEFT$(LAST.NAME$,1)=" " THEN _
GOTO 12500
12550 ACTIVE.USER.NAME$ = MID$(FIRST.NAME$ + " " + LAST.NAME$,1,31)
IF HASH.INDIV > 1 THEN _
IF Q < 3 THEN _
GOSUB 12558 : _
IF NO THEN _
GOTO 12500
Z$ = FIRST.NAME$
RETURN
'
' * CHECK FOR NAMES NOT ALLOWED *
'
12555 GOSUB 12995
IF Q = 0 THEN _
RETURN 12500
I = 1
12556 Z$ = B$(I)
12557 CALL ALLCAPS (Z$)
CALL REMNONALF (Z$,31,91)
RETURN
12558 A$ = "Are you '" + _
ACTIVE.USER.NAME$ + _
"' ([Y],N)"
GOSUB 12995
RETURN
12570 FOUND = FALSE
CALL OPENWORK (TRASHCAN.FILE$)
IF EC = 53 THEN _
GOTO 710
12580 IF EOF(2) THEN _
RETURN
INPUT #2,INVALID.NAME$
IF Z$ <> INVALID.NAME$ THEN _
GOTO 12580
FOUND = TRUE
RETURN
12595 CALL QTPUT ("Real name required. Call traced & recorded",1)
CALL UPDTCALR ("Name violation: "+ACTIVE.USER.NAME$,1)
GOTO 10621
'
' * COMMON SEARCH USER FILE ROUTINE *
'
12598 TEMP.HASH.VALUE$ = HASH.VALUE$
TEMP.INDIV.VALUE$ = INDIV.VALUE$
12600 GOSUB 4910
GOSUB 12988
IF IN.CONF.MENU THEN _
IF NOT PRIVATE.DOOR THEN _
CALL QTPUT ("Checking Users...",1)
12605 CALL OPENUSER (HIGHEST.USER.RECORD)
GOSUB 9450
CALL FINDUSER (TEMP.HASH.VALUE$,TEMP.INDIV.VALUE$,START.HASH,LEN.HASH,_
START.INDIV,LEN.INDIV,HIGHEST.USER.RECORD,FOUND,_
USER.FILE.INDEX,SL)
IF FOUND THEN _
RETURN
IF CURRENT.USER.COUNT < (HIGHEST.USER.RECORD-1)*.95 THEN _
RETURN
A$ = "No room for new users in " + GRN$
CALL UPDTCALR (A$,2)
IF ACTIVE.USER.FILE$ <> MAIN.USER.FILE$ THEN _
USER.FILE.INDEX = 0 : _
RETURN
IF REMEMBER.NEW.USERS AND NOT SURVIVE.NOUSER.ROOM THEN _
GOSUB 1397
USER.FILE.INDEX = 0
IF SURVIVE.NOUSER.ROOM THEN _
REMEMBER.NEW.USERS = FALSE
RETURN
'
' * AUGMENT USER COUNT, LOCK 4 REC BLOCK IN USER, UNLOCK FILES *
'
12630 GOSUB 23000
CURRENT.USER.COUNT = CURRENT.USER.COUNT + (SL = 0) * REMEMBER.NEW.USERS
12632 GOSUB 24000
GOSUB 12985
IF REMEMBER.NEW.USERS THEN _
GOSUB 12989
GOSUB 12990
RETURN
'
' * INFORM USER OF WHAT CONFERENCE USER FILE HE IS VIEWING *
'
12700 IF CONFERENCE.MODE THEN _
A$ = "Users of " + _
GRN$ + _
":" : _
GOSUB 12979
RETURN
'
' * GET PASSWORD FROM NEWUSER *
'
12800 A$ = "Enter PASSWORD you'll use to logon again"
GOSUB 12995
IF USER.SECURITY.LEVEL.SAVE < SYSOP.SECURITY.LEVEL THEN _
IF B$ = SPACE$(LEN(B$)) THEN _
GOTO 12800
IF LEN(B$) > 15 THEN _
CALL QTPUT ("15 Char. Max",1) : _
GOTO 12800
CALL ALLCAPS (B$)
Z$ = B$
LSET PASSWORD$ = Z$
RETURN
'
' * GET HASH VALUE FOR CURRENT USER TO LOOK UP IN THE USER'S FILE *
'
12840 IF START.HASH = 1 THEN _
HASH.VALUE$ = ACTIVE.USER.NAME$ : _
RETURN
X$ = A1$ + _
PROMPT.HASH$
CALL UNTILRIGHT (X$,HASH.VALUE$,2,LEN.HASH)
RETURN
'
' * GET FIELD TO INDIVIDUATE ONE USER FROM ANOTHER (NAME FIELD IS DEFAULT) *
'
12850 IF START.INDIV < 1 THEN _
RETURN
IF START.INDIV = 1 THEN _
INDIV.VALUE$ = ACTIVE.USER.NAME$ : _
RETURN
X$ = A1$ + _
PROMPT.INDIV$
CALL UNTILRIGHT (X$,INDIV.VALUE$,2,LEN.INDIV)
RETURN
'
' * SET NEWUSER DEFAULTS *
'
12900 LSET USER.NAME$ = ACTIVE.USER.NAME$
LSET USER.OPTIONS$ = MKI$(0) + _
MKI$(0) + _
" 0" + _
MKI$(64) + _
MKI$(16) + _
MKI$(0) + _
CHR$(23) + _
DEFAULT.ECHOER$
LSET USER.DOWNLOADS$ = MKI$(0)
LSET USER.UPLOADS$ = MKI$(0)
IF ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _
LSET TODAY.DL$ = MKS$(0) : _
LSET TODAY.BYTES$ = MKS$(0) : _
LSET DL.BYTES$ = MKS$(0) : _
LSET UL.BYTES$ = MKS$(0)
LSET SECURITY.LEVEL$ = MKI$(TEMP.SECURITY.LEVEL)
LSET ELAPSED.TIME$ = MKI$(0)
RETURN
'
' * GET CITY AND STATE FROM NEWUSER *
'
12960 A$ = A1$ + _
USER.LOCATION$
GOSUB 12995
IF Q = 0 THEN _
GOTO 12960
IF B$ = SPACE$(LEN(B$)) THEN _
GOTO 12960
CALL ALLCAPS (B$)
LSET CITY.STATE$ = B$
CI$ = B$
RETURN
'
' * S - COMMAND FROM 5 - USER MAINTENANCE OPTIONS (SCAN USERS) *
'
12962 X = 0
FF = FALSE
A$ = "String to search"
GOSUB 12998
IF Q = 0 THEN _
GOTO 11000
CALL ALLCAPS (B$)
WK$ = B$
IF SCAN.FUNCTION$ = "L" THEN _
WK$ = "," + _
STR$(VAL(WK$)) + _
","
12963 GET 5,I
GOSUB 12966
X = INSTR(SCAN.FIELD$,WK$)
IF X > 0 THEN _
GOTO 11015
12965 I = I + 1
IF I > HIGHEST.USER.RECORD - 1 THEN _
GOTO 11000
X = 0
GOTO 12963
12966 FF = INSTR("NCPL",SCAN.FUNCTION$)
12967 ON FF GOTO 12968,12969,12970,12972
GOTO 11000
'
' * N - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR NAME) *
'
12968 SCAN.FIELD$ = USER.NAME$
RETURN
'
' * C - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR CITY/ST) *
'
12969 SCAN.FIELD$ = CITY.STATE$
RETURN
'
' * P - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR PASSWORD)*
'
12970 SCAN.FIELD$ = PASSWORD$
RETURN
'
' * L - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR LEVEL) *
'
12972 SCAN.FIELD$ = "," + _
STR$(CVI(SECURITY.LEVEL$)) + _
","
RETURN
'
' * CALLS INTO SEPARATELY COMPILED SUBROUTINES (RBBS-SUB) *
'
'
' * STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTINE *
'
12975 SUBROUTINE.PARAMETER = 1
GOTO 12981
12976 SUBROUTINE.PARAMETER = 2
GOTO 12981
12977 SUBROUTINE.PARAMETER = 3
GOTO 12981
12978 SUBROUTINE.PARAMETER = 4
GOTO 12981
12979 SUBROUTINE.PARAMETER = 5
GOTO 12981
12980 SUBROUTINE.PARAMETER = 6
12981 CALL TPUT
12983 IF SUBROUTINE.PARAMETER < 0 THEN _
GOTO 202
IF SUBROUTINE.PARAMETER = 8 THEN _
GOSUB 12995
RETURN
'
' * STANDARD ENTRY FOR RBBS-PC'S FILE LOCKING WHEN RUNNING MULTIPLE RBBS-PC'S *
'
12984 SUBROUTINE.PARAMETER = 1 ' LOCK USERS & MESSAGES
GOTO 12994
12985 SUBROUTINE.PARAMETER = 2 ' UNLOCK MESSAGES AND FLUSH
FLUSHED = TRUE
GOTO 12994
12986 SUBROUTINE.PARAMETER = 3 ' LOCK MESSAGES
GOTO 12994
12987 SUBROUTINE.PARAMETER = 4 ' UNLOCK MESSAGES
GOTO 12994
12988 SUBROUTINE.PARAMETER = 5 ' LOCK USERS
GOTO 12994
12989 SUBROUTINE.PARAMETER = 6 ' LOCK USER BLOCK
GOTO 12994
12990 SUBROUTINE.PARAMETER = 7 ' UNLOCK USERS
GOTO 12994
12991 SUBROUTINE.PARAMETER = 8 ' UNLOCK USER BLOCK
GOTO 12994
12992 SUBROUTINE.PARAMETER = 9 ' LOCK COMMENTS/UPLOAD DIR
GOTO 12994
12993 SUBROUTINE.PARAMETER = 10 ' UNLOCK COMMENTS/UPLOAD DIR
12994 CALL FILELOCK
IF FLUSHED THEN _
FIELD 1,128 AS MESSAGE.RECORD$ : _
FLUSHED = FALSE
IF SUBROUTINE.PARAMETER = -1 THEN _
SUBROUTINE.PARAMETER = -9 : _
CALL FINDFUNC : _
GOTO 202
RETURN
'
' * STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE *
'
12995 SUBROUTINE.PARAMETER = 1
12996 CALL TGET
12997 IF SUBROUTINE.PARAMETER < 0 THEN _
GOTO 202
RETURN
12998 A$ = A$ + _
PRESS.ENTER$
GOTO 12995
12999 TURBO.KEY = -TURBO.KEY.USER
GOTO 12995
'
' * MAIN SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE *
'
13000 IF DEBUG THEN _
A$ = "DEBUG Trap ERL=" + _
STR$(EL) + _
" ERR=" + _
STR$(EC) : _
CALL PRINTIT(A$) : _
D$ = A$ : _
GOSUB 1315
IF EL = 1905 AND EC = 63 THEN _
CLOSE 1 : _
KILL ACTIVE.MESSAGE.FILE$ : _
GOTO 5350
IF EL = 4371 AND EC = 6 THEN _
GOTO 1200
IF EL = 4740 THEN _
GOTO 4745
IF EL = 5151 AND EC = 62 THEN _
CALL UPDTCALR (PASSWORDS.FILE$ + " bad format!",2) : _
GOTO 5160
13500 CALL LOGERROR
CALL QTPUT (CALLERS.RECORD$,1)
GOTO 1200
'
' * COMMON EXIT FROM RBBS-PC (I.E. "ABANDON ALL HOPE OH YE WHO ENTER HERE") *
'
13538 CALL UPDTCALR ("No calls. Recycling.",1)
GOTO 13549
13540 IF LOCAL.USER THEN _
IF NOT LOCAL.USER.MODE THEN _
GOTO 13549
13543 IF (NOT SYSOP) THEN _
IF ((USER.FILE.INDEX = 0 AND REMEMBER.NEW.USERS) OR _
NEW.USER = TRUE) THEN _
GOTO 13549
13545 CALL UPDATEC
13549 GOSUB 13700
IF LOCAL.USER OR _
MODEM.OFFHOOK THEN _
GOTO 13555
IF NOT FOSSIL THEN _
OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) AND 254 : _
CALL DELAYIT (DTR.DROP.DELAY) : _
OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1 : _
GOTO 13553
13550 CALL FOSSTATUS(COMPORT%,STATUS%)
STATUS% = STATUS% AND &H4000
IF STATUS% <> &H4000 THEN _
CALL DELAYIT (8 + BPS)
STATE%=0
CALL FOSDTR(COMPORT%,STATE%)
CALL DELAYIT (DTR.DROP.DELAY)
STATE%=1
CALL FOSDTR(COMPORT%,STATE%)
13553 CALL DELAYIT (DTR.DROP.DELAY)
CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
13555 ACTIVE.MESSAGE.FILE$ = ORIG.MESSAGE.FILE$
GOSUB 12986
GOSUB 5344
GET 1,NODE.RECORD.INDEX
EXIT.TO.DOORS = FALSE
MID$(MESSAGE.RECORD$,57,1) = "I"
MID$(MESSAGE.RECORD$,40,2) = STR$(EXIT.TO.DOORS)
PUT 1,NODE.RECORD.INDEX
GOSUB 12985
CLOSE 1,2,4,5
IF NOT FOSSIL THEN _
CLOSE 3
IF RECYCLE.TO.DOS THEN _
GOTO 203
RUN 100
13600 CLS
LOCATE ,,0
D$ = DF$ + _
" file not found/invalid. Run CONFIG."
GOSUB 1315
CALL DELAYIT (3)
GOTO 203
13700 IF MESSAGE.FILE.LOCK THEN _
GOSUB 12987
13710 IF USER.FILE.LOCK THEN _
GOSUB 12990
13720 IF USER.BLOCK.LOCK THEN _
GOSUB 12991
RETURN
'
' * C/R - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (QUIT TO MAIN MENU)*
'
20093 IF USER.FILE.INDEX > 0 THEN _
CALL OPENUSER (HIGHEST.USER.RECORD) : _
GET 5,USER.FILE.INDEX : _
GOSUB 9500
20095 RETURN 1200
'
' * V - COMMAND FROM FILES MENU (VIEW ARC CONTENTS) *
'
20140 CALL GETARC
IF SUBROUTINE.PARAMETER = -1 THEN _
GOTO 13540
IF DENY.ACCESS THEN _
GOTO 1386
RETURN
'
' * GO TO THE FILE SYSTEM TO LIST THE SYSOP'S COMMENTS
'
20150 FILESYS.PARAMETER = 1
GOTO 20200
'
' * GO TO THE FILE SYSTEM TO LIST THE FILE DIRECTORIES
'
20155 FILESYS.PARAMETER = 2
GOTO 20200
'
' * GO TO THE FILE SYSTEM TO DOWNLOAD FILES
'
20160 FILESYS.PARAMETER = 3
GOTO 20200
'
' * GO TO THE FILE SYSTEM WHEN RETURNING FROM EXTERNAL PROTOCOLS
'
20165 FILESYS.PARAMETER = 4
GOTO 20200
'
' * GO TO THE FILE SYSTEM TO UPLOAD FILES
'
20170 FILESYS.PARAMETER = 5
GOTO 20200
'
' * GO TO THE FILE SYSTEM TO SCAN FILE SYSTEM DIRECTORIES
'
20175 FILESYS.PARAMETER = 6
GOTO 20200
'
' * GO TO THE FILE SYSTEM TO HANDLE "PERSONAL" FILES
'
20180 FILESYS.PARAMETER = 7
GOTO 20200
'
' * GO TO THE FILE SYSTEM TO LIST "NEW" FILES
'
20185 FILESYS.PARAMETER = 8
GOTO 20200
'
' * RETURN TO THE FILE SYSTEM AFTER HANDLING EXTENDED FILE DESCRIPTIONS
'
20190 FILESYS.PARAMETER = 9
20200 CALL FILESYS
ON FILESYS.PARAMETER GOTO 20205, _
20210, _
20215, _
20220, _
20225, _
20230, _
20235
20205 RETURN
20210 RETURN 202
20215 RETURN 1200
20220 RETURN 1380
20225 SYSOP.COMMENT = TRUE
MAX.MESSAGE.LINES = MAX.EXTENDED.LINES
GOSUB 2008
GOTO 20190
20230 RETURN 10553
20235 RETURN 10595
'
' * GET MESSAGE HEADER RECORD DATA
'
23000 GET 1,1
HIGH.MESSAGE.NUMBER = VAL(LEFT$(MESSAGE.RECORD$,8))
AUTO.ADD.SECURITY = CVI(MID$(MESSAGE.RECORD$,9,2))
CALLS.TODATE! = VAL(MID$(MESSAGE.RECORD$,11,10))
CURRENT.USER.COUNT = VAL(MID$(MESSAGE.RECORD$,57,5))
'HIGHEST.USER.RECORD = VAL(MID$(MESSAGE.RECORD$,62,5))
FIRST.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,68,7))
NEXT.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,75,7))
HIGHEST.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,82,7))
IF ACTIVE.MESSAGE.FILE$ = ORIG.MESSAGE.FILE$ THEN _
NODES.IN.SYSTEM = VAL(MID$(MESSAGE.RECORD$,127))
RETURN
'
' * UPDATE MESSAGE HEADER RECORD DATA *
'
24000 MID$(MESSAGE.RECORD$,1,8) = STR$(HIGH.MESSAGE.NUMBER)
MID$(MESSAGE.RECORD$,11,10) = STR$(CALLS.TODATE!)
MID$(MESSAGE.RECORD$,57,5) = STR$(CURRENT.USER.COUNT)
' MID$(MESSAGE.RECORD$,62,5) = STR$(HIGHEST.USER.RECORD)
MID$(MESSAGE.RECORD$,68,7) = STR$(FIRST.MESSAGE.RECORD)
MID$(MESSAGE.RECORD$,75,7) = STR$(NEXT.MESSAGE.RECORD)
MID$(MESSAGE.RECORD$,82,7) = STR$(HIGHEST.MESSAGE.RECORD)
PUT 1,1
RETURN
'
' * A - COMMAND FROM LIBRARY MENU (ARCHIVE A SELECTED LIBRARY DISK) *
'
30000 SUBROUTINE.PARAMETER = 4
CALL LIBRARY
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10595
RETURN
'
' * C - COMMAND FROM LIBRARY MENU (CHANGE TO A LIBRARY DISK) *
'
30100 SUBROUTINE.PARAMETER = 2
CALL LIBRARY
RETURN
'
' * D - COMMAND FROM LIBRARY MENU (DOWNLOAD F DISK/FILE FROM LIBRARY) *
'
30200 IF TIME.LOCK AND 2 THEN _
CALL TIMELOCK : _
IF NOT OK THEN _
RETURN
IF LIBRARY.DISK.CHAR$ = "0000" THEN _
CALL QTPUT ("You must select a Library disk first!",1) : _
RETURN
SUBROUTINE.PARAMETER = 3
CALL LIBRARY
GOTO 20160
'
' * CALCULATE TIME REMAINING FOR USER *
'
41000 CALL CHKTREMAIN (TIME.REMAINING!)
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10553
RETURN
'
' * SHOW USER CURRENT ACCESS LEVEL *
'
41070 A$ = "Granted access level" + _
STR$(USER.SECURITY.LEVEL) + _
MID$(" (SYSOP)",1,-8 * (USER.SECURITY.LEVEL >= SYSOP.SECURITY.LEVEL))
GOSUB 12975
RETURN
'
' * NULLS SET FOR NEW USERS *
'
42700 CALL SKIPLINE (1)
CALL QTPUT ("TurboKey: act on 1 character command without waiting for [ENTER]",1)
A$ = "Want TurboKeys (Y/[N])"
GOSUB 12999
TURBO.KEY.USER = NOT YES
CALL TOGGLE (8)
RETURN
'
' * F - COMMAND FROM UTILITY MENU (FILE TRANSFER DEFALUT MODE) *
' * FILE TRANSFER DEFAULT SET FOR NEW USERS *
'
42800 FF = INSTR(DFLTXFER$,USER.TRANSFER.DEFAULT$)
IF FF = 0 THEN _
FF = INSTR(INTERNAL.EQUIV$,"N")
CALL QTPUT ("Current Protocol: "+MID$(DFLTXFER$,FF,1),1)
42805 A$ = "Default "
CALL XFERTYPE (1,EXPERT.USER)
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10595
USER.TRANSFER.DEFAULT$ = FT$
42810 A$ = "PROTOCOL: " + PROTO.PROMPT$
GOSUB 12979
RETURN
'
' * C - COMMAND FROM UTILITY MENU (CHANGE CASE TOGGLE) *
' * UPPER/LOWER CASE SET FOR NEW USERS *
'
42850 IF Q > 1 THEN _
X = 2 : _
GOTO 42852
GOSUB 9525
42851 X = 1
A$ = "Change to R)BBS, C)aller's software" + _
MID$(", I)ntermediate host",1,-20 * (HOST.ECHO.ON$ <> "")) + _
PRESS.ENTER.EXPERT$
GOSUB 12999
IF Q = 0 THEN _
RETURN
42852 Z$ = LEFT$(B$(X),1)
CALL ALLCAPS (Z$)
IF INSTR("ICR",Z$) = 0 THEN _
GOTO 42851
ECHOER$ = Z$
CALL SETECHO (ECHOER$)
GOSUB 9525
RETURN
42950 A$ = "CAN YOUR TERMINAL DISPLAY LOWER CASE ([Y]/N)"
GOSUB 12995
UPPER.CASE = NOT NO
CALL TOGGLE(3)
RETURN
'
' * G - COMMAND FROM UTILITY MENU (GRAPHICS WANTED) *
' * GRAPHIC MENUS SELECTION SET FOR NEW USERS *
'
43000 GOSUB 43005
GOTO 43022
43005 CALL ASKGRAPH (USER.GRAPHIC.DEFAULT$)
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10595
IF Q = 0 THEN _
RETURN
43020 A$ = "Text GRAPHICS: " + _
MID$("None AsciiColor",GR * 5 + 1,5)
GOSUB 12979
RETURN
43022 IF EMPHASIZE.ON.DEF$ = "" THEN _
RETURN
A$ = "Do you want COLORIZED prompts ([Y],N)"
GOSUB 12999
HIGHLIGHT.OFF = NOT NO
CALL TOGGLE(5)
RETURN
43025 CALL GRAPHIC (USER.GRAPHIC.DEFAULT$)
'
' * DISPLAY NON-BREAKABLE TEXT FILES *
'
43027 STOP.INTERRUPTS = TRUE
CALL BUFFILE (FILE.NAME$,X)
CALL CARRIER
IF SUBROUTINE.PARAMETER = -1 THEN _
RETURN 10595
STOP.INTERRUPTS = FALSE
RETURN
'
' * MAKE INPUT STRING HIDDEN (USE *'S TO ECHO INPUT) *
'
45010 HIDDEN = TRUE
GOSUB 12995
HIDDEN = FALSE
RETURN